From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Lars Brinkhoff Newsgroups: gmane.emacs.devel Subject: Re: RFC: User-defined pseudovectors Date: Thu, 10 Oct 2013 13:29:31 +0200 Organization: nocrew Message-ID: <85fvs9cqjo.fsf@junk.nocrew.org> References: <85k3hlcqvm.fsf@junk.nocrew.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: ger.gmane.org 1381404702 862 80.91.229.3 (10 Oct 2013 11:31:42 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Thu, 10 Oct 2013 11:31:42 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Thu Oct 10 13:31:45 2013 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1VUESx-0000uO-FX for ged-emacs-devel@m.gmane.org; Thu, 10 Oct 2013 13:31:39 +0200 Original-Received: from localhost ([::1]:46421 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VUESx-0000gW-3C for ged-emacs-devel@m.gmane.org; Thu, 10 Oct 2013 07:31:39 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:44260) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VUERF-0006yD-2b for emacs-devel@gnu.org; Thu, 10 Oct 2013 07:30:00 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VUER7-00051y-By for emacs-devel@gnu.org; Thu, 10 Oct 2013 07:29:52 -0400 Original-Received: from plane.gmane.org ([80.91.229.3]:58665) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VUER7-00051Z-0T for emacs-devel@gnu.org; Thu, 10 Oct 2013 07:29:45 -0400 Original-Received: from list by plane.gmane.org with local (Exim 4.69) (envelope-from ) id 1VUER3-0007zh-OO for emacs-devel@gnu.org; Thu, 10 Oct 2013 13:29:41 +0200 Original-Received: from c-4957e555.012-14-67626717.cust.bredbandsbolaget.se ([85.229.87.73]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Thu, 10 Oct 2013 13:29:41 +0200 Original-Received: from lars by c-4957e555.012-14-67626717.cust.bredbandsbolaget.se with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Thu, 10 Oct 2013 13:29:41 +0200 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 210 Original-X-Complaints-To: usenet@ger.gmane.org X-Gmane-NNTP-Posting-Host: c-4957e555.012-14-67626717.cust.bredbandsbolaget.se User-Agent: Gnus/5.11 (Gnus v5.11) Emacs/22.2 (gnu/linux) Cancel-Lock: sha1:ZqEU2YHqXhufLL4AXjBupMuPMCQ= X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 80.91.229.3 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 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-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:164059 Archived-At: I wrote: > With the current FFI discussion, this may be a good time to ask for > input on a Lisp extension I have lying around. Here is the patch in its current (unfinished) state. Suggestions are welcome. Would something like this be useful for inclusion in Emacs? diff a/src/alloc.c b/src/alloc.c --- a/src/alloc.c +++ b/src/alloc.c @@ -3048,6 +3048,12 @@ allocate_hash_table (void) return ALLOCATE_PSEUDOVECTOR (struct Lisp_Hash_Table, count, PVEC_HASH_TABLE); } +struct Lisp_Vector * +allocate_typed_pseudovector (int count) +{ + return allocate_pseudovector (count, count, PVEC_TYPED_PSEUDOVECTOR); +} + struct window * allocate_window (void) { @@ -3096,6 +3102,30 @@ allocate_process (void) return p; } +DEFUN ("make-typed-pseudovector", Fmake_typed_pseudovector, Smake_typed_pseudovector, 3, 3, 0, + doc: /* Create a new vector-like object of type TYPE with SLOTS elements, each initialized to INIT. */) + (register Lisp_Object slots, Lisp_Object type, Lisp_Object init) +{ + Lisp_Object vector; + register ptrdiff_t size; + register ptrdiff_t i; + register struct Lisp_Vector *p; + + CHECK_NATNUM (slots); + if (!SYMBOLP(type)) + signal_error ("Invalid type; must be symbol", type); + + size = XFASTINT (slots) + 1; + p = allocate_typed_pseudovector (size); + p->u.contents[0] = type; + for (i = 1; i < size; i++) + p->u.contents[i] = init; + + XSETVECTOR (vector, p); + return vector; +} + + DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0, doc: /* Return a newly created vector of length LENGTH, with each element being INIT. See also the function `vector'. */) @@ -6755,6 +6785,7 @@ The time is in seconds as a floating point value. */); defsubr (&Smake_byte_code); defsubr (&Smake_list); defsubr (&Smake_vector); + defsubr (&Smake_typed_pseudovector); defsubr (&Smake_string); defsubr (&Smake_bool_vector); defsubr (&Smake_symbol); diff a/src/data.c b/src/data.c --- a/src/data.c +++ b/src/data.c @@ -290,6 +290,9 @@ for example, (type-of 1) returns `integer'. */) return Qfont_entity; if (FONT_OBJECT_P (object)) return Qfont_object; + if (TYPED_PSEUDOVECTOR_P (object)) + return AREF (object, 0); + return Qvector; case Lisp_Float: @@ -370,6 +373,15 @@ DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0, return Qnil; } +DEFUN ("typed-pseudovector-p", Ftyped_pseudovector_p, Styped_pseudovector_p, 1, 1, 0, + doc: /* Return t if OBJECT is a typed pseudovector. */) + (Lisp_Object object) +{ + if (TYPED_PSEUDOVECTOR_P (object)) + return Qt; + return Qnil; +} + DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0, doc: /* Return t if OBJECT is a string. */) (Lisp_Object object) @@ -2146,7 +2158,7 @@ or a byte-code object. IDX starts at 0. */) ptrdiff_t size = 0; if (VECTORP (array)) size = ASIZE (array); - else if (COMPILEDP (array)) + else if (COMPILEDP (array) || TYPED_PSEUDOVECTOR_P (array)) size = ASIZE (array) & PSEUDOVECTOR_SIZE_MASK; else wrong_type_argument (Qarrayp, array); @@ -2167,7 +2179,8 @@ bool-vector. IDX starts at 0. */) CHECK_NUMBER (idx); idxval = XINT (idx); - CHECK_ARRAY (array, Qarrayp); + if (! TYPED_PSEUDOVECTOR_P (array)) + CHECK_ARRAY (array, Qarrayp); CHECK_IMPURE (array); if (VECTORP (array)) @@ -2196,7 +2209,14 @@ bool-vector. IDX starts at 0. */) CHECK_CHARACTER (idx); CHAR_TABLE_SET (array, idxval, newelt); } - else + else if (TYPED_PSEUDOVECTOR_P (array)) + { + ptrdiff_t size = ASIZE (array) & PSEUDOVECTOR_SIZE_MASK; + if (idxval < 0 || idxval >= size) + args_out_of_range (array, idx); + ASET (array, idxval, newelt); + } + else /* STRINGP */ { int c; @@ -3506,6 +3526,7 @@ syms_of_data (void) defsubr (&Sstringp); defsubr (&Smultibyte_string_p); defsubr (&Svectorp); + defsubr (&Styped_pseudovector_p); defsubr (&Schar_table_p); defsubr (&Svector_or_char_table_p); defsubr (&Sbool_vector_p); diff a/src/fns.c b/src/fns.c --- a/src/fns.c +++ b/src/fns.c @@ -115,7 +115,7 @@ To get the number of bytes, use `string-bytes'. */) XSETFASTINT (val, MAX_CHAR); else if (BOOL_VECTOR_P (sequence)) XSETFASTINT (val, XBOOL_VECTOR (sequence)->size); - else if (COMPILEDP (sequence)) + else if (COMPILEDP (sequence) || TYPED_PSEUDOVECTOR_P (sequence)) XSETFASTINT (val, ASIZE (sequence) & PSEUDOVECTOR_SIZE_MASK); else if (CONSP (sequence)) { diff a/src/lisp.h b/src/lisp.h --- a/src/lisp.h +++ b/src/lisp.h @@ -538,6 +538,7 @@ enum pvec_type PVEC_TERMINAL, PVEC_WINDOW_CONFIGURATION, PVEC_SUBR, + PVEC_TYPED_PSEUDOVECTOR, PVEC_OTHER, /* These should be last, check internal_equal to see why. */ PVEC_COMPILED, @@ -2328,6 +2329,12 @@ FRAMEP (Lisp_Object a) return PSEUDOVECTORP (a, PVEC_FRAME); } +INLINE bool +TYPED_PSEUDOVECTOR_P (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_TYPED_PSEUDOVECTOR); +} + /* Test for image (image . spec) */ INLINE bool IMAGEP (Lisp_Object x) diff a/src/lread.c b/src/lread.c --- a/src/lread.c +++ b/src/lread.c @@ -2603,6 +2603,19 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) make_byte_code (vec); return tmp; } + if (c == '%') + { + c = READCHAR; + if (c == '[') + { + Lisp_Object tmp; + tmp = read_vector (readcharfun, 1); + XSETPVECTYPE (XVECTOR(tmp), PVEC_TYPED_PSEUDOVECTOR); + return tmp; + } + UNREAD (c); + invalid_syntax ("#"); + } if (c == '(') { Lisp_Object tmp; diff a/src/print.c b/src/print.c --- a/src/print.c +++ b/src/print.c @@ -1945,6 +1945,12 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) PRINTCHAR ('#'); size &= PSEUDOVECTOR_SIZE_MASK; } + if (TYPED_PSEUDOVECTOR_P (obj)) + { + PRINTCHAR ('#'); + PRINTCHAR ('%'); + size &= PSEUDOVECTOR_SIZE_MASK; + } if (CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)) { /* We print a char-table as if it were a vector,