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:21:48 +0100 Organization: nocrew Message-ID: <86bmsyts9f.fsf@molnjunk.nocrew.org> References: <86y3w2tt2n.fsf@molnjunk.nocrew.org> <86tw6qtt01.fsf@molnjunk.nocrew.org> <86k27mtsnv.fsf@molnjunk.nocrew.org> <86fuiatsh3.fsf@molnjunk.nocrew.org> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: blaine.gmane.org 1489857942 31127 195.159.176.226 (18 Mar 2017 17:25:42 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Sat, 18 Mar 2017 17:25:42 +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:25:38 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 1cpI6h-0007OW-3v for ged-emacs-devel@m.gmane.org; Sat, 18 Mar 2017 18:25:35 +0100 Original-Received: from localhost ([::1]:54168 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cpI6m-0002Yu-TY for ged-emacs-devel@m.gmane.org; Sat, 18 Mar 2017 13:25:40 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:58679) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cpI6c-0002Xf-QC for emacs-devel@gnu.org; Sat, 18 Mar 2017 13:25:31 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cpI6Y-0005a1-S4 for emacs-devel@gnu.org; Sat, 18 Mar 2017 13:25:30 -0400 Original-Received: from [195.159.176.226] (port=39979 helo=blaine.gmane.org) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cpI6Y-0005ZT-L0 for emacs-devel@gnu.org; Sat, 18 Mar 2017 13:25:26 -0400 Original-Received: from list by blaine.gmane.org with local (Exim 4.84_2) (envelope-from ) id 1cpI6C-0004Y0-9h for emacs-devel@gnu.org; Sat, 18 Mar 2017 18:25:04 +0100 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 67 Original-X-Complaints-To: usenet@blaine.gmane.org Cancel-Lock: sha1:VOFUgcp14x39i7STRGrHWSNXj8k= 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:213135 Archived-At: Backward compatibility with pre-existing struct instances. If old-struct-compat is set to `t', `type-of' will make an educated guess whether a vector is a legacy struct instance. If so, the returned type will be the contents of slot 0. * src/data.c (old_struct_prefix, old_struct_prefix_length): New variables. (vector_struct_p, type_of_vector): New functions. (Ftype_of): Call type_of_vector. (old-struct-compat): New variable. diff --git a/src/data.c b/src/data.c index 8e0bccc..5a91d92 100644 --- a/src/data.c +++ b/src/data.c @@ -201,6 +201,30 @@ static void swap_in_symval_forwarding (struct Lisp_Symbol *, return Qnil; } +static const char *old_struct_prefix = "cl-struct-"; +static int old_struct_prefix_length; + +static int +vector_struct_p (Lisp_Object object) +{ + if (! old_struct_compat || ASIZE (object) < 1) + return false; + + Lisp_Object type = AREF (object, 0); + return SYMBOLP (type) + && strncmp (SDATA (SYMBOL_NAME (type)), + old_struct_prefix, + old_struct_prefix_length) == 0; +} + +static Lisp_Object +type_of_vector (Lisp_Object object) +{ + if (vector_struct_p (object)) + return AREF (object, 0); + return Qvector; +} + DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0, doc: /* Return a symbol representing the type of OBJECT. The symbol returned names the object's basic type; @@ -243,7 +267,7 @@ static void swap_in_symval_forwarding (struct Lisp_Symbol *, case Lisp_Vectorlike: switch (PSEUDOVECTOR_TYPE (XVECTOR (object))) { - case PVEC_NORMAL_VECTOR: return Qvector; + case PVEC_NORMAL_VECTOR: return type_of_vector (object); case PVEC_WINDOW_CONFIGURATION: return Qwindow_configuration; case PVEC_PROCESS: return Qprocess; case PVEC_WINDOW: return Qwindow; @@ -3873,6 +3897,11 @@ enum bool_vector_op { bool_vector_exclusive_or, Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM); make_symbol_constant (intern_c_string ("most-negative-fixnum")); + DEFVAR_BOOL ("old-struct-compat", old_struct_compat, + doc: /* Non-nil means hack for old structs is in effect. */); + old_struct_compat = 0; + old_struct_prefix_length = strlen (old_struct_prefix); + DEFSYM (Qwatchers, "watchers"); DEFSYM (Qmakunbound, "makunbound"); DEFSYM (Qunlet, "unlet");