[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] trunk r116995: cl-lib defstruct introspection
From: |
Daniel Colascione |
Subject: |
[Emacs-diffs] trunk r116995: cl-lib defstruct introspection |
Date: |
Sun, 20 Apr 2014 02:51:25 +0000 |
User-agent: |
Bazaar (2.6b2) |
------------------------------------------------------------
revno: 116995 [merge]
revision-id: address@hidden
parent: address@hidden
parent: address@hidden
committer: Daniel Colascione <address@hidden>
branch nick: trunk
timestamp: Sat 2014-04-19 19:51:17 -0700
message:
cl-lib defstruct introspection
modified:
doc/misc/ChangeLog changelog-20091113204419-o5vbwnq5f7feedwu-6331
doc/misc/cl.texi cl.texi-20091113204419-o5vbwnq5f7feedwu-6292
etc/ChangeLog changelog-20091113204419-o5vbwnq5f7feedwu-1485
etc/NEWS news-20100311060928-aoit31wvzf25yr1z-1
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 'doc/misc/ChangeLog'
--- a/doc/misc/ChangeLog 2014-04-17 01:35:20 +0000
+++ b/doc/misc/ChangeLog 2014-04-20 02:50:36 +0000
@@ -1,3 +1,7 @@
+2014-04-20 Daniel Colascione <address@hidden>
+
+ * cl.texi (Declarations): Document changes to `cl-the' and defstruct
functions.
+
2014-04-17 Paul Eggert <address@hidden>
* Makefile.in (infoclean): Be consistent about reporting failures.
=== modified file 'doc/misc/cl.texi'
--- a/doc/misc/cl.texi 2014-02-03 07:26:59 +0000
+++ b/doc/misc/cl.texi 2014-04-20 02:50:36 +0000
@@ -2627,10 +2627,10 @@
@end defmac
@defmac cl-the type form
-Type information provided by @code{cl-the} is ignored in this package;
-in other words, @code{(cl-the @var{type} @var{form})} is equivalent to
address@hidden Future byte-compiler optimizations may make use of this
-information.
address@hidden returns the value of @code{form}, first checking (if
+optimization settings permit) that it is of type @code{type}. Future
+byte-compiler optimizations may also make use of this information to
+improve runtime efficiency.
For example, @code{mapcar} can map over both lists and arrays. It is
hard for the compiler to expand @code{mapcar} into an in-line loop
@@ -4247,6 +4247,51 @@
Except as noted, the @code{cl-defstruct} facility of this package is
entirely compatible with that of Common Lisp.
+The @code{cl-defstruct} package also provides a few structure
+introspection functions.
+
address@hidden cl-struct-sequence-type struct-type
+This function returns the underlying data structure for
address@hidden, which is a symbol. It returns @code{vector} or
address@hidden, or @code{nil} if @code{struct-type} is not actually a
+structure.
address@hidden defun
+
address@hidden cl-struct-slot-info struct-type
+This function returns a list of slot descriptors for structure
address@hidden Each entry in the list is @code{(name . opts)},
+where @code{name} is the name of the slot and @code{opts} is the list
+of slot options given to @code{defstruct}. Dummy entries represent
+the slots used for the struct name and that are skipped to implement
address@hidden:initial-offset}.
address@hidden defun
+
address@hidden cl-struct-slot-offset struct-type slot-name
+Return the offset of slot @code{slot-name} in @code{struct-type}. The
+returned zero-based slot index is relative to the start of the
+structure data type and is adjusted for any structure name and
+:initial-offset slots. Signal error if struct @code{struct-type} does
+not contain @code{slot-name}.
address@hidden defun
+
address@hidden cl-struct-slot-value struct-type slot-name inst
+Return the value of slot @code{slot-name} in @code{inst} of
address@hidden @code{struct} and @code{slot-name} are symbols.
address@hidden is a structure instance. This routine is also a
address@hidden place. @code{cl-struct-slot-value} uses
address@hidden internally and can signal the same
+errors.
address@hidden defun
+
address@hidden cl-struct-set-slot-value struct-type slot-name inst value
+Set the value of slot @code{slot-name} in @code{inst} of
address@hidden @code{struct} and @code{slot-name} are symbols.
address@hidden is a structure instance. @code{value} is the value to
+which to set the given slot. Return @code{value}.
address@hidden uses @code{cl-struct-set-slot-offset}
+internally and can signal the same errors.
address@hidden defun
+
@node Assertions
@chapter Assertions and Errors
=== modified file 'etc/ChangeLog'
--- a/etc/ChangeLog 2014-04-17 07:54:23 +0000
+++ b/etc/ChangeLog 2014-04-20 02:50:36 +0000
@@ -1,3 +1,7 @@
+2014-04-20 Daniel Colascione <address@hidden>
+
+ * NEWS: Mention new struct functions and changes to `cl-the'.
+
2014-04-17 Daniel Colascione <address@hidden>
* NEWS: Mention bracketed paste support.
=== modified file 'etc/NEWS'
--- a/etc/NEWS 2014-04-17 07:54:23 +0000
+++ b/etc/NEWS 2014-04-20 02:50:36 +0000
@@ -90,6 +90,8 @@
** deactivate-mark is now buffer-local.
+** cl-the now asserts that its argument is of the given type.
+
* Lisp Changes in Emacs 24.5
@@ -97,6 +99,9 @@
** You can specify a function's interactive-only property via `declare'.
However you specify it, the property affects `describe-function' output.
+** 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
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2014-04-19 20:32:05 +0000
+++ b/lisp/ChangeLog 2014-04-20 02:34:22 +0000
@@ -1,3 +1,16 @@
+2014-04-20 Daniel Colascione <address@hidden>
+
+ * emacs-lisp/cl-macs.el (cl-the): Make `cl-the' assert its type
+ argument.
+ (cl--const-expr-val): cl--const-expr-val should macroexpand its
+ argument in case we're inside a symbol-macrolet.
+ (cl--do-arglist, cl--compiler-macro-typep)
+ (cl--compiler-macro-member, cl--compiler-macro-assoc): Pass macro
+ environment to `cl--const-expr-val'.
+ (cl-struct-sequence-type,cl-struct-slot-info)
+ (cl-struct-slot-offset, cl-struct-slot-value)
+ (cl-struct-set-slot-value): New functions.
+
2014-04-19 Stefan Monnier <address@hidden>
* progmodes/sh-script.el (sh-smie--sh-keyword-p): Handle variable
=== modified file 'lisp/emacs-lisp/cl-macs.el'
--- a/lisp/emacs-lisp/cl-macs.el 2014-03-26 15:57:13 +0000
+++ b/lisp/emacs-lisp/cl-macs.el 2014-04-20 02:34:22 +0000
@@ -134,8 +134,15 @@
((symbolp x) (and (memq x '(nil t)) t))
(t t)))
-(defun cl--const-expr-val (x)
- (and (macroexp-const-p x) (if (consp x) (nth 1 x) x)))
+(defun cl--const-expr-val (x &optional environment default)
+ "Return the value of X known at compile-time.
+If X is not known at compile time, return DEFAULT. Before
+testing whether X is known at compile time, macroexpand it in
+ENVIRONMENT."
+ (let ((x (macroexpand-all x environment)))
+ (if (macroexp-const-p x)
+ (if (consp x) (nth 1 x) x)
+ default)))
(defun cl--expr-contains (x y)
"Count number of times X refers to Y. Return nil for 0 times."
@@ -519,7 +526,8 @@
look
`(or ,look
,(if (eq (cl--const-expr-p def) t)
- `'(nil ,(cl--const-expr-val def))
+ `'(nil ,(cl--const-expr-val
+ def
macroexpand-all-environment))
`(list nil ,def))))))))
(push karg keys)))))
(setq keys (nreverse keys))
@@ -2057,10 +2065,21 @@
(declare (debug t))
(cons 'progn body))
;;;###autoload
-(defmacro cl-the (_type form)
- "At present this ignores TYPE and is simply equivalent to FORM."
+(defmacro cl-the (type form)
+ "Return FORM. If type-checking is enabled, assert that it is of TYPE."
(declare (indent 1) (debug (cl-type-spec form)))
- form)
+ (if (not (or (not (cl--compiling-file))
+ (< cl--optimize-speed 3)
+ (= cl--optimize-safety 3)))
+ form
+ (let* ((temp (if (cl--simple-expr-p form 3)
+ form (make-symbol "--cl-var--")))
+ (body `(progn (unless ,(cl--make-type-test temp type)
+ (signal 'wrong-type-argument
+ (list ',type ,temp ',form)))
+ ,temp)))
+ (if (eq temp form) body
+ `(let ((,temp ,form)) ,body)))))
(defvar cl--proclaim-history t) ; for future compilers
(defvar cl--declare-stack t) ; for future compilers
@@ -2577,6 +2596,83 @@
forms)
`(progn ,@(nreverse (cons `',name forms)))))
+(defun cl-struct-sequence-type (struct-type)
+ "Return the sequence used to build STRUCT-TYPE.
+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)
+
+(defun cl-struct-slot-info (struct-type)
+ "Return a list of slot names of struct STRUCT-TYPE.
+Each entry is a list (SLOT-NAME . OPTS), where SLOT-NAME is a
+slot name symbol and OPTS is a list of slot options given to
+`cl-defstruct'. Dummy slots that represent the struct name and
+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)
+
+(defun cl-struct-slot-offset (struct-type slot-name)
+ "Return the offset of slot SLOT-NAME in STRUCT-TYPE.
+The returned zero-based slot index is relative to the start of
+the structure data type and is adjusted for any structure name
+and :initial-offset slots. Signal error if struct STRUCT-TYPE
+does not contain SLOT-NAME."
+ (or (cl-position slot-name
+ (cl-struct-slot-info struct-type)
+ :key #'car :test #'eq)
+ (error "struct %s has no slot %s" struct-type slot-name)))
+(put 'cl-struct-slot-offset 'side-effect-free t)
+
+(defun cl-struct-slot-value (struct-type slot-name inst)
+ "Return the value of slot SLOT-NAME in INST of STRUCT-TYPE.
+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)))
+(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))
+
+(defsetf 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* ((macenv macroexpand-all-environment)
+ (struct-type (cl--const-expr-val struct-type macenv))
+ (slot-name (cl--const-expr-val slot-name macenv)))
+ (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* ((macenv macroexpand-all-environment)
+ (struct-type (cl--const-expr-val struct-type macenv))
+ (slot-name (cl--const-expr-val slot-name macenv)))
+ (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))
+
;;; Types and assertions.
;;;###autoload
@@ -2653,7 +2749,8 @@
(defun cl--compiler-macro-typep (form val type)
(if (macroexp-const-p type)
(macroexp-let2 macroexp-copyable-p temp val
- (cl--make-type-test temp (cl--const-expr-val type)))
+ (cl--make-type-test temp (cl--const-expr-val
+ type macroexpand-all-environment)))
form))
;;;###autoload
@@ -2829,7 +2926,8 @@
(defun cl--compiler-macro-member (form a list &rest keys)
(let ((test (and (= (length keys) 2) (eq (car keys) :test)
- (cl--const-expr-val (nth 1 keys)))))
+ (cl--const-expr-val (nth 1 keys)
+ macroexpand-all-environment))))
(cond ((eq test 'eq) `(memq ,a ,list))
((eq test 'equal) `(member ,a ,list))
((or (null keys) (eq test 'eql)) `(memql ,a ,list))
@@ -2837,11 +2935,12 @@
(defun cl--compiler-macro-assoc (form a list &rest keys)
(let ((test (and (= (length keys) 2) (eq (car keys) :test)
- (cl--const-expr-val (nth 1 keys)))))
+ (cl--const-expr-val (nth 1 keys)
+ macroexpand-all-environment))))
(cond ((eq test 'eq) `(assq ,a ,list))
((eq test 'equal) `(assoc ,a ,list))
((and (macroexp-const-p a) (or (null keys) (eq test 'eql)))
- (if (floatp (cl--const-expr-val a))
+ (if (floatp (cl--const-expr-val a macroexpand-all-environment))
`(assoc ,a ,list) `(assq ,a ,list)))
(t form))))
=== modified file 'test/ChangeLog'
--- a/test/ChangeLog 2014-04-19 20:32:05 +0000
+++ b/test/ChangeLog 2014-04-20 02:34:22 +0000
@@ -1,3 +1,7 @@
+2014-04-20 Daniel Colascione <address@hidden>
+
+ * automated/cl-lib.el (cl-lib-struct-accessors,cl-the): New tests.
+
2014-04-19 Michael Albinus <address@hidden>
* automated/tramp-tests.el (tramp--test-check-files): Extend test.
=== modified file 'test/automated/cl-lib.el'
--- a/test/automated/cl-lib.el 2014-03-23 06:02:36 +0000
+++ b/test/automated/cl-lib.el 2014-04-20 02:34:22 +0000
@@ -201,4 +201,23 @@
:b :a :a 42)
'(42 :a))))
+(ert-deftest cl-lib-struct-accessors ()
+ (cl-defstruct mystruct (abc :readonly t) def)
+ (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)
+ (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))
+ (should (equal (cl-struct-slot-info 'mystruct)
+ '((cl-tag-slot) (abc :readonly t) (def))))))
+
+(ert-deftest cl-the ()
+ (should (eql (the integer 42) 42))
+ (should-error (the integer "abc"))
+ (let ((sideffect 0))
+ (should (= (the integer (incf sideffect)) 1))
+ (should (= sideffect 1))))
+
;;; cl-lib.el ends here
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] trunk r116995: cl-lib defstruct introspection,
Daniel Colascione <=