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 Date: Tue, 14 Mar 2017 13:28:09 +0100 Organization: nocrew Message-ID: <86shmg11ra.fsf@molnjunk.nocrew.org> References: <87pokampa4.fsf@ericabrahamsen.net> <8760m2mmlq.fsf@ericabrahamsen.net> <87lguq5r87.fsf@ericabrahamsen.net> <878tp0i74g.fsf@users.sourceforge.net> <87efyg6y0i.fsf_-_@drachen> <87zigwz9wx.fsf@tromey.com> <86bmtbd45s.fsf@molnjunk.nocrew.org> <867f3s2nik.fsf_-_@molnjunk.nocrew.org> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: blaine.gmane.org 1489494531 30603 195.159.176.226 (14 Mar 2017 12:28:51 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Tue, 14 Mar 2017 12:28:51 +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 Tue Mar 14 13:28:42 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 1cnlZ8-0006mT-N7 for ged-emacs-devel@m.gmane.org; Tue, 14 Mar 2017 13:28:38 +0100 Original-Received: from localhost ([::1]:58447 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cnlZE-0008Q6-JW for ged-emacs-devel@m.gmane.org; Tue, 14 Mar 2017 08:28:44 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:40892) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cnlZ2-0008NV-Qd for emacs-devel@gnu.org; Tue, 14 Mar 2017 08:28:34 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cnlYy-0007yj-V2 for emacs-devel@gnu.org; Tue, 14 Mar 2017 08:28:32 -0400 Original-Received: from [195.159.176.226] (port=59860 helo=blaine.gmane.org) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cnlYy-0007yO-Ni for emacs-devel@gnu.org; Tue, 14 Mar 2017 08:28:28 -0400 Original-Received: from list by blaine.gmane.org with local (Exim 4.84_2) (envelope-from ) id 1cnlYi-0004UX-0t for emacs-devel@gnu.org; Tue, 14 Mar 2017 13:28:12 +0100 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 74 Original-X-Complaints-To: usenet@blaine.gmane.org Cancel-Lock: sha1:+eeWnJBAv3Vzd6DEfmqGCw0xBkQ= 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:213014 Archived-At: Lars Brinkhoff wrote: > This is my old patch dusted off and rebased to current master. > It's just a raw material posted for review. This is how cl-defstruct could be modified to optionally make record instances. More work would probably be needed in cl-preloaded.el and cl-generic.el. Test case: (cl-defstruct (foo (:type record)) x y z) (let ((x (make-foo :y 1))) (list (type-of x) (foo-p x) (recordp x) (foo-y x) x)) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 40342f3..dead86e 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2544,6 +2544,12 @@ cl--sublis (cons (cl--sublis alist (car tree)) (cl--sublis alist (cdr tree)))) (t tree)))) +(defun record (type &rest elements) + (let ((result (make-record type (length elements) nil)) + (i 0)) + (dolist (elt elements result) + (aset result (cl-incf i) elt)))) + ;;; Structures. (defmacro cl--find-class (type) @@ -2656,6 +2662,8 @@ cl-defstruct descs))) (t (error "Structure option %s unrecognized" opt))))) + (if (eq type 'record) + (setq named t)) (unless (or include-name type) (setq include-name cl--struct-default-parent)) (when include-name (setq include (cl--struct-get-class include-name))) @@ -2684,7 +2692,7 @@ cl-defstruct (if (cl--struct-class-named include) (setq tag name named t))) (if type (progn - (or (memq type '(vector list)) + (or (memq type '(vector list record)) (error "Invalid :type specifier: %s" type)) (if named (setq tag name))) (setq named 'true))) @@ -2700,6 +2708,9 @@ cl-defstruct `(and (vectorp cl-x) (>= (length cl-x) ,(length descs)) (memq (aref cl-x ,pos) ,tag-symbol))) + ((eq type 'record) + `(and (recordp cl-x) + (memq (type-of cl-x) ,tag-symbol))) ((= pos 0) `(memq (car-safe cl-x) ,tag-symbol)) (t `(and (consp cl-x) (memq (nth ,pos cl-x) ,tag-symbol)))))) @@ -2740,7 +2751,7 @@ cl-defstruct (list `(or ,pred-check (signal 'wrong-type-argument (list ',name cl-x))))) - ,(if (memq type '(nil vector)) `(aref cl-x ,pos) + ,(if (memq type '(nil vector record)) `(aref cl-x ,pos) (if (= pos 0) '(car cl-x) `(nth ,pos cl-x)))) forms)