From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Lars Brinkhoff Newsgroups: gmane.emacs.devel Subject: Re: User-defined record types, v2 Date: Sat, 18 Mar 2017 18:17:12 +0100 Organization: nocrew Message-ID: <86fuiatsh3.fsf@molnjunk.nocrew.org> References: <86y3w2tt2n.fsf@molnjunk.nocrew.org> <86tw6qtt01.fsf@molnjunk.nocrew.org> <86k27mtsnv.fsf@molnjunk.nocrew.org> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: blaine.gmane.org 1489857637 16657 195.159.176.226 (18 Mar 2017 17:20:37 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sat, 18 Mar 2017 17:20:37 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3 (gnu/linux) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sat Mar 18 18:20:33 2017 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1cpI1l-0003Pw-3J for ged-emacs-devel@m.gmane.org; Sat, 18 Mar 2017 18:20:29 +0100 Original-Received: from localhost ([::1]:54144 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cpI1p-0000H4-Hb for ged-emacs-devel@m.gmane.org; Sat, 18 Mar 2017 13:20:33 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:57058) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cpI1d-0000Ed-LT for emacs-devel@gnu.org; Sat, 18 Mar 2017 13:20:22 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cpI1Z-0003Qc-LC for emacs-devel@gnu.org; Sat, 18 Mar 2017 13:20:21 -0400 Original-Received: from [195.159.176.226] (port=59383 helo=blaine.gmane.org) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cpI1Z-0003Q3-9d for emacs-devel@gnu.org; Sat, 18 Mar 2017 13:20:17 -0400 Original-Received: from list by blaine.gmane.org with local (Exim 4.84_2) (envelope-from ) id 1cpI1L-00012U-8b for emacs-devel@gnu.org; Sat, 18 Mar 2017 18:20:03 +0100 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 135 Original-X-Complaints-To: usenet@blaine.gmane.org Cancel-Lock: sha1:mr88TrI10WvPzVXK6+L0OeDy6Oo= X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] [fuzzy] X-Received-From: 195.159.176.226 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:213134 Archived-At: Make EIEIO use records. * lisp/emacs-lisp/eieio-core.el: Use records, and place the class object directly as tag. (eieio--object-class): Adjust to new tag representation. (eieio-object-p): Rewrite. (eieio-defclass-internal): Use `make-record'. (eieio--generic-generalizer): Adjust generalizer code accordingly. * lisp/emacs-lisp/eieio.el (make-instance, clone): Use copy-record. * lisp/emacs-lisp/pcase.el (pcase-mutually-exclusive-predicates): Add `recordp'. diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 5cc6d02..882e7fb 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -122,7 +122,7 @@ eieio-default-superclass (length (cl-struct-slot-info 'eieio--object)))) (defsubst eieio--object-class (obj) - (symbol-value (eieio--object-class-tag obj))) + (eieio--object-class-tag obj)) ;;; Important macros used internally in eieio. @@ -166,13 +166,7 @@ eieio--class-option (defun eieio-object-p (obj) "Return non-nil if OBJ is an EIEIO object." - (and (vectorp obj) - (> (length obj) 0) - (let ((tag (eieio--object-class-tag obj))) - (and (symbolp tag) - ;; (eq (symbol-function tag) :quick-object-witness-check) - (boundp tag) - (eieio--class-p (symbol-value tag)))))) + (eieio--class-p (type-of obj))) (define-obsolete-function-alias 'object-p 'eieio-object-p "25.1") @@ -496,18 +490,10 @@ eieio-defclass-internal (if clearparent (setf (eieio--class-parents newc) nil)) ;; Create the cached default object. - (let ((cache (make-vector (+ (length (eieio--class-slots newc)) + (let ((cache (make-record newc + (+ (length (eieio--class-slots newc)) (eval-when-compile eieio--object-num-slots)) - nil)) - ;; We don't strictly speaking need to use a symbol, but the old - ;; code used the class's name rather than the class's object, so - ;; we follow this preference for using a symbol, which is probably - ;; convenient to keep the printed representation of such Elisp - ;; objects readable. - (tag (intern (format "eieio-class-tag--%s" cname)))) - (set tag newc) - (fset tag :quick-object-witness-check) - (setf (eieio--object-class-tag cache) tag) + nil))) (let ((eieio-skip-typecheck t)) ;; All type-checking has been done to our satisfaction ;; before this call. Don't waste our time in this call.. @@ -1060,9 +1046,9 @@ 'inconsistent-class-hierarchy ;; part of the dispatch code. 50 #'cl--generic-struct-tag (lambda (tag &rest _) - (and (symbolp tag) (boundp tag) (eieio--class-p (symbol-value tag)) + (and (eieio--class-p tag) (mapcar #'eieio--class-name - (eieio--class-precedence-list (symbol-value tag)))))) + (eieio--class-precedence-list tag))))) (cl-defmethod cl-generic-generalizers :extra "class" (specializer) "Support for dispatch on types defined by EIEIO's `defclass'." diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 1a6d5e9..f3530ca 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -701,8 +701,8 @@ 'constructor This static method is called when an object is constructed. It allocates the vector used to represent an EIEIO object, and then calls `initialize-instance' on that object." - (let* ((new-object (copy-sequence (eieio--class-default-object-cache - (eieio--class-object class))))) + (let* ((new-object (copy-record (eieio--class-default-object-cache + (eieio--class-object class))))) (if (and slots (let ((x (car slots))) (or (stringp x) (null x)))) @@ -806,7 +806,7 @@ 'constructor (cl-defmethod clone ((obj eieio-default-superclass) &rest params) "Make a copy of OBJ, and then apply PARAMS." - (let ((nobj (copy-sequence obj))) + (let ((nobj (copy-record obj))) (if (stringp (car params)) (funcall (if eieio-backward-compatibility #'ignore #'message) "Obsolete name %S passed to clone" (pop params))) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 289265a..6c4ac51 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -503,24 +503,30 @@ pcase-mutually-exclusive-predicates (symbolp . vectorp) (symbolp . stringp) (symbolp . byte-code-function-p) + (symbolp . recordp) (integerp . consp) (integerp . arrayp) (integerp . vectorp) (integerp . stringp) (integerp . byte-code-function-p) + (integerp . recordp) (numberp . consp) (numberp . arrayp) (numberp . vectorp) (numberp . stringp) (numberp . byte-code-function-p) + (numberp . recordp) (consp . arrayp) (consp . atom) (consp . vectorp) (consp . stringp) (consp . byte-code-function-p) + (consp . recordp) (arrayp . byte-code-function-p) (vectorp . byte-code-function-p) + (vectorp . recordp) (stringp . vectorp) + (stringp . recordp) (stringp . byte-code-function-p))) (defun pcase--mutually-exclusive-p (pred1 pred2)