From: Stefan Monnier <monnier@iro.umontreal.ca>
To: emacs-devel@gnu.org
Subject: new `obarray` type
Date: Sun, 12 Mar 2017 21:36:26 -0400 [thread overview]
Message-ID: <jwv37eiuh5j.fsf-monnier+gmane.emacs.devel@gnu.org> (raw)
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 ("#<obarray", printcharfun);
+ print_c_string (" :size ", printcharfun);
+ print_object (make_number (OBARRAY_SIZE (obj)),
+ printcharfun, escapeflag);
+ print_c_string (" :count ", printcharfun);
+ print_object (Fobarray_count (obj),
+ printcharfun, escapeflag);
+ print_c_string (">", printcharfun);
+ }
+ break;
+
case PVEC_BUFFER:
{
if (!BUFFER_LIVE_P (XBUFFER (obj)))
next reply other threads:[~2017-03-13 1:36 UTC|newest]
Thread overview: 14+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-03-13 1:36 Stefan Monnier [this message]
2017-03-13 15:49 ` new `obarray` type Eli Zaretskii
2017-03-13 17:22 ` Stefan Monnier
2017-03-13 22:03 ` Alan Mackenzie
2017-03-14 1:46 ` Herring, Davis
2017-03-14 12:52 ` Stefan Monnier
2017-03-14 20:14 ` Alan Mackenzie
2017-03-15 17:25 ` Stefan Monnier
2017-03-15 18:19 ` Lars Brinkhoff
2017-03-15 19:24 ` (:named nil) in cl-defstruct (was: new `obarray` type) Stefan Monnier
2017-03-15 19:39 ` Noam Postavsky
2017-03-15 20:28 ` (:named nil) in cl-defstruct Stefan Monnier
2017-07-23 14:03 ` Converting CC Mode's obarrays to hash tables. [Was: new `obarray` type] Alan Mackenzie
2017-07-24 14:06 ` Stefan Monnier
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=jwv37eiuh5j.fsf-monnier+gmane.emacs.devel@gnu.org \
--to=monnier@iro.umontreal.ca \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.