From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.devel Subject: new `obarray` type Date: Sun, 12 Mar 2017 21:36:26 -0400 Message-ID: NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit X-Trace: blaine.gmane.org 1489369049 17008 195.159.176.226 (13 Mar 2017 01:37:29 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Mon, 13 Mar 2017 01:37:29 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.50 (gnu/linux) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Mar 13 02:37:25 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 1cnEvJ-0003RN-9Y for ged-emacs-devel@m.gmane.org; Mon, 13 Mar 2017 02:37:21 +0100 Original-Received: from localhost ([::1]:49604 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cnEvP-0002Ub-3C for ged-emacs-devel@m.gmane.org; Sun, 12 Mar 2017 21:37:27 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:36936) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cnEug-0002UJ-NS for emacs-devel@gnu.org; Sun, 12 Mar 2017 21:36:44 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cnEud-0005uY-4r for emacs-devel@gnu.org; Sun, 12 Mar 2017 21:36:42 -0400 Original-Received: from [195.159.176.226] (port=57866 helo=blaine.gmane.org) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cnEuc-0005tA-Qu for emacs-devel@gnu.org; Sun, 12 Mar 2017 21:36:39 -0400 Original-Received: from list by blaine.gmane.org with local (Exim 4.84_2) (envelope-from ) id 1cnEuT-0006pI-OA for emacs-devel@gnu.org; Mon, 13 Mar 2017 02:36:29 +0100 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 359 Original-X-Complaints-To: usenet@blaine.gmane.org Cancel-Lock: sha1:caMXNNnRB0QOD+LzBr9goo9ex6g= 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:212971 Archived-At: The patch below introduces a new type for obarrays, distinct from vectors. Among other things, this makes it possible to print them in a more useful way (it doesn't print the contents, only the size, so the printed form is not computer-readable, but it's more palatable to the user). Printing obarrays in a `read`able way seems like something that should be under the control of variable, since it's unclear in general what it would mean (for abbrev-tables, it would probably mean to print the name of every symbol, along with it value, function, and plist slots, but doing that for the `obarray` variable doesn't seem right (and it's not even clear what the `value` of each symbol in it should be, for buffer-local symbols)). Stefan diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 0ccf6a17ff..1739fbcc9f 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -1207,7 +1207,7 @@ cl--generic-typeof-types (process atom) (window atom) (subr atom) (compiled-function function atom) (buffer atom) (char-table array sequence atom) (bool-vector array sequence atom) - (frame atom) (hash-table atom) (terminal atom) + (frame atom) (hash-table atom) (terminal atom) (obarray atom) (thread atom) (mutex atom) (condvar atom) (font-spec atom) (font-entity atom) (font-object atom) (vector array sequence atom) diff --git a/lisp/obarray.el b/lisp/obarray.el index aaffe00a07..db13a17572 100644 --- a/lisp/obarray.el +++ b/lisp/obarray.el @@ -32,15 +32,7 @@ obarray-default-size (defun obarray-make (&optional size) "Return a new obarray of size SIZE or `obarray-default-size'." - (let ((size (or size obarray-default-size))) - (if (< 0 size) - (make-vector size 0) - (signal 'wrong-type-argument '(size 0))))) - -(defun obarrayp (object) - "Return t if OBJECT is an obarray." - (and (vectorp object) - (< 0 (length object)))) + (make-obarray (or size obarray-default-size))) ;; Don’t use obarray as a variable name to avoid shadowing. (defun obarray-get (ob name) diff --git a/src/alloc.c b/src/alloc.c index 03774e60b6..5ace037351 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3412,6 +3412,23 @@ See also the function `vector'. */) return make_lisp_ptr (p, Lisp_Vectorlike); } +DEFUN ("make-obarray", Fmake_obarray, Smake_obarray, 1, 1, 0, + doc: /* Return a newly created obarray of size LENGTH. */) + (Lisp_Object length) +{ + CHECK_NATNUM (length); + EMACS_INT l = XFASTINT (length); + if (l >= (1 << PSEUDOVECTOR_SIZE_BITS)) + error ("Obarray too large"); + else if (l <= 0) + error ("Obarray too small"); + struct Lisp_Vector *p = allocate_vector (l); + for (ptrdiff_t i = 0; i < l; i++) + p->contents[i] = make_number (0); + XSETPVECTYPE (p, PVEC_OBARRAY); + return make_lisp_ptr (p, Lisp_Vectorlike); +} + DEFUN ("vector", Fvector, Svector, 0, MANY, 0, doc: /* Return a newly created vector with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. @@ -7593,6 +7610,7 @@ The time is in seconds as a floating point value. */); defsubr (&Smake_byte_code); defsubr (&Smake_list); defsubr (&Smake_vector); + defsubr (&Smake_obarray); defsubr (&Smake_string); defsubr (&Smake_bool_vector); defsubr (&Smake_symbol); diff --git a/src/data.c b/src/data.c index df0c3a92a9..183adeb1ea 100644 --- a/src/data.c +++ b/src/data.c @@ -250,6 +250,7 @@ for example, (type-of 1) returns `integer'. */) case PVEC_WINDOW: return Qwindow; case PVEC_SUBR: return Qsubr; case PVEC_COMPILED: return Qcompiled_function; + case PVEC_OBARRAY: return Qobarray; case PVEC_BUFFER: return Qbuffer; case PVEC_CHAR_TABLE: return Qchar_table; case PVEC_BOOL_VECTOR: return Qbool_vector; @@ -360,6 +361,17 @@ DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0, return Qnil; } +DEFUN ("obarrayp", Fobarrayp, Sobarrayp, 1, 1, 0, + doc: /* Return t if OBJECT is an obarray. */) + (Lisp_Object object) +{ + if (OBARRAYP (object)) + return Qt; + if (VECTORP (object) && ASIZE (object) > 0) /* Backward compatibility. */ + return Qt; + return Qnil; +} + DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0, doc: /* Return t if OBJECT is a string. */ attributes: const) @@ -3580,6 +3592,7 @@ syms_of_data (void) DEFSYM (Qsequencep, "sequencep"); DEFSYM (Qbufferp, "bufferp"); DEFSYM (Qvectorp, "vectorp"); + DEFSYM (Qobarrayp, "obarrayp"); DEFSYM (Qbool_vector_p, "bool-vector-p"); DEFSYM (Qchar_or_string_p, "char-or-string-p"); DEFSYM (Qmarkerp, "markerp"); @@ -3699,6 +3712,7 @@ syms_of_data (void) DEFSYM (Qdefun, "defun"); + DEFSYM (Qobarray, "obarray"); DEFSYM (Qfont_spec, "font-spec"); DEFSYM (Qfont_entity, "font-entity"); DEFSYM (Qfont_object, "font-object"); @@ -3727,6 +3741,7 @@ syms_of_data (void) defsubr (&Smultibyte_string_p); defsubr (&Sunibyte_string_p); defsubr (&Svectorp); + defsubr (&Sobarrayp); defsubr (&Schar_table_p); defsubr (&Svector_or_char_table_p); defsubr (&Sbool_vector_p); diff --git a/src/lisp.h b/src/lisp.h index 2f97fb8afa..b9a99523d2 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -883,6 +883,7 @@ enum pvec_type PVEC_THREAD, PVEC_MUTEX, PVEC_CONDVAR, + PVEC_OBARRAY, /* These should be last, check internal_equal to see why. */ PVEC_COMPILED, @@ -2814,6 +2815,26 @@ COMPILEDP (Lisp_Object a) } INLINE bool +OBARRAYP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_OBARRAY); +} + +INLINE ptrdiff_t +OBARRAY_SIZE (Lisp_Object obarray) +{ + return (OBARRAYP (obarray) + ? ASIZE (obarray) & PSEUDOVECTOR_SIZE_MASK + : gc_asize (obarray)); +} + +INLINE void +CHECK_OBARRAY (Lisp_Object x) +{ + CHECK_TYPE (OBARRAYP (x), Qobarrayp, x); +} + +INLINE bool FRAMEP (Lisp_Object a) { return PSEUDOVECTORP (a, PVEC_FRAME); diff --git a/src/lread.c b/src/lread.c index c8632399f7..1c788e5ce5 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3772,12 +3767,13 @@ check_obarray (Lisp_Object obarray) /* We don't want to signal a wrong-type-argument error when we are shutting down due to a fatal error, and we don't want to hit assertions in VECTORP and ASIZE if the fatal error was during GC. */ - if (!fatal_error_in_progress - && (!VECTORP (obarray) || ASIZE (obarray) == 0)) + if (!(fatal_error_in_progress + || OBARRAYP (obarray) + || (VECTORP (obarray) && ASIZE (obarray) > 0))) { /* If Vobarray is now invalid, force it to be valid. */ if (EQ (Vobarray, obarray)) Vobarray = initial_obarray; - wrong_type_argument (Qvectorp, obarray); + wrong_type_argument (Qobarrayp, obarray); } return obarray; } @@ -3877,6 +3873,9 @@ it defaults to the value of `obarray'. */) obarray = check_obarray (NILP (obarray) ? Vobarray : obarray); CHECK_STRING (string); + if (VECTORP (obarray) + && ASIZE (obarray) < (1 << PSEUDOVECTOR_SIZE_BITS)) + XSETPVECTYPE (XVECTOR (obarray), PVEC_OBARRAY); tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); if (!SYMBOLP (tem)) @@ -4004,7 +4003,7 @@ oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff obarray = check_obarray (obarray); /* This is sometimes needed in the middle of GC. */ - obsize = gc_asize (obarray); + obsize = OBARRAY_SIZE (obarray); hash = hash_string (ptr, size_byte) % obsize; bucket = AREF (obarray, hash); oblookup_last_bucket_number = hash; @@ -4031,8 +4030,8 @@ map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Ob { ptrdiff_t i; register Lisp_Object tail; - CHECK_VECTOR (obarray); - for (i = ASIZE (obarray) - 1; i >= 0; i--) + CHECK_OBARRAY (obarray); + for (i = OBARRAY_SIZE (obarray) - 1; i >= 0; i--) { tail = AREF (obarray, i); if (SYMBOLP (tail)) @@ -4064,12 +4063,33 @@ OBARRAY defaults to the value of `obarray'. */) return Qnil; } -#define OBARRAY_SIZE 15121 +static void +obarray_count_1 (Lisp_Object sym, Lisp_Object counter) +{ + Fsetcar (counter, make_number (1 + XFASTINT (XCAR (counter)))); +} + +DEFUN ("obarray-count", Fobarray_count, Sobarray_count, 1, 1, 0, + doc: /* Count number of element in OBARRAY. */) + (Lisp_Object obarray) +{ + obarray = check_obarray (obarray); + Lisp_Object counter = Fcons (make_number (0), Qnil); + map_obarray (obarray, obarray_count_1, counter); + return XCAR (counter); +} + +/* This was recently bumped to 15121, but now that we use PVEC_OBARRAY + * it needs to be smaller than 4096 (aka 1 << PSEUDOVECTOR_SIZE_BITS). + * FIXME: We could use a higher value by putting half the size bits + * in PSEUDOVECTOR_SIZE and the other alf in PSEUDOVECTOR_REST, or by + * moving the PVEC_OBARRAY to PSEUDOVECTOR_FLAG. */ +#define OBARRAY_SIZE 4093 void init_obarray (void) { - Vobarray = Fmake_vector (make_number (OBARRAY_SIZE), make_number (0)); + Vobarray = Fmake_obarray (make_number (OBARRAY_SIZE)); initial_obarray = Vobarray; staticpro (&initial_obarray); @@ -4502,6 +4522,7 @@ syms_of_lread (void) defsubr (&Sread_event); defsubr (&Sget_file_char); defsubr (&Smapatoms); + defsubr (&Sobarray_count); defsubr (&Slocate_file_internal); DEFVAR_LISP ("obarray", Vobarray, diff --git a/src/minibuf.c b/src/minibuf.c index cc8252b068..01ab69cb6d 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1216,7 +1216,7 @@ is used to further constrain the set of candidates. */) ptrdiff_t compare, matchsize; enum { function_table, list_table, obarray_table, hash_table} type = (HASH_TABLE_P (collection) ? hash_table - : VECTORP (collection) ? obarray_table + : (OBARRAYP (collection) || VECTORP (collection)) ? obarray_table : ((NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection))) ? list_table : function_table)); @@ -1237,7 +1237,7 @@ is used to further constrain the set of candidates. */) if (type == obarray_table) { collection = check_obarray (collection); - obsize = ASIZE (collection); + obsize = OBARRAY_SIZE (collection); bucket = AREF (collection, idx); } @@ -1473,7 +1473,7 @@ with a space are ignored unless STRING itself starts with a space. */) Lisp_Object tail, elt, eltstring; Lisp_Object allmatches; int type = HASH_TABLE_P (collection) ? 3 - : VECTORP (collection) ? 2 + : (OBARRAYP (collection) || VECTORP (collection)) ? 2 : NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection)); ptrdiff_t idx = 0, obsize = 0; ptrdiff_t bindcount = -1; @@ -1490,7 +1490,7 @@ with a space are ignored unless STRING itself starts with a space. */) if (type == 2) { collection = check_obarray (collection); - obsize = ASIZE (collection); + obsize = OBARRAY_SIZE (collection); bucket = AREF (collection, idx); } @@ -1513,8 +1513,7 @@ with a space are ignored unless STRING itself starts with a space. */) { if (!EQ (bucket, zero)) { - if (!SYMBOLP (bucket)) - error ("Bad data in guts of obarray"); + CHECK_SYMBOL (bucket); elt = bucket; eltstring = elt; if (XSYMBOL (bucket)->next) @@ -1696,7 +1695,7 @@ the values STRING, PREDICATE and `lambda'. */) if (NILP (tem)) return Qnil; } - else if (VECTORP (collection)) + else if (OBARRAYP (collection) || VECTORP (collection)) { /* Bypass intern-soft as that loses for nil. */ tem = oblookup (collection, diff --git a/src/print.c b/src/print.c index 5d4076c896..586e094ced 100644 --- a/src/print.c +++ b/src/print.c @@ -1855,6 +1855,19 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) } break; + case PVEC_OBARRAY: + { + print_c_string ("#", printcharfun); + } + break; + case PVEC_BUFFER: { if (!BUFFER_LIVE_P (XBUFFER (obj)))