diff options
| -rw-r--r-- | doc/lispref/elisp.texi | 7 | ||||
| -rw-r--r-- | doc/lispref/objects.texi | 24 | ||||
| -rw-r--r-- | doc/lispref/records.texi | 98 | ||||
| -rw-r--r-- | src/alloc.c | 93 | ||||
| -rw-r--r-- | src/data.c | 35 | ||||
| -rw-r--r-- | src/fns.c | 2 | ||||
| -rw-r--r-- | src/lisp.h | 14 | ||||
| -rw-r--r-- | src/lread.c | 14 | ||||
| -rw-r--r-- | src/print.c | 27 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/cl-print-tests.el | 10 | ||||
| -rw-r--r-- | test/src/alloc-tests.el | 20 |
11 files changed, 333 insertions, 11 deletions
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index e0bd337e53b..0f7efb6f187 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -180,6 +180,7 @@ To view this manual in other formats, click * Sequences Arrays Vectors:: Lists, strings and vectors are called sequences. Certain functions act on any kind of sequence. The description of vectors is here as well. +* Records:: Compound objects with programmer-defined types. * Hash Tables:: Very fast lookup-tables. * Symbols:: Symbols represent names, uniquely. @@ -314,6 +315,7 @@ Programming Types expression, more fundamental but less pretty. * Primitive Function Type:: A function written in C, callable from Lisp. * Byte-Code Type:: A function written in Lisp, then compiled. +* Record Type:: Compound objects with programmer-defined types. * Autoload Type:: A type used for automatically loading seldom-used functions. * Finalizer Type:: Runs code when no longer reachable. @@ -418,6 +420,10 @@ Sequences, Arrays, and Vectors * Bool-Vectors:: How to work with bool-vectors. * Rings:: Managing a fixed-size ring of objects. +Records + +* Record Functions:: Functions for records. + Hash Tables * Creating Hash:: Functions to create hash tables. @@ -1594,6 +1600,7 @@ Object Internals @include lists.texi @include sequences.texi +@include records.texi @include hash.texi @include symbols.texi @include eval.texi diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 56049af60a1..90cafbef642 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -25,9 +25,10 @@ but not for @emph{the} type of an object. which all other types are constructed, are called @dfn{primitive types}. Each object belongs to one and only one primitive type. These types include @dfn{integer}, @dfn{float}, @dfn{cons}, @dfn{symbol}, -@dfn{string}, @dfn{vector}, @dfn{hash-table}, @dfn{subr}, and -@dfn{byte-code function}, plus several special types, such as -@dfn{buffer}, that are related to editing. (@xref{Editing Types}.) +@dfn{string}, @dfn{vector}, @dfn{hash-table}, @dfn{subr}, +@dfn{byte-code function}, and @dfn{record}, plus several special +types, such as @dfn{buffer}, that are related to editing. +(@xref{Editing Types}.) Each primitive type has a corresponding Lisp function that checks whether an object is a member of that type. @@ -154,6 +155,7 @@ latter are unique to Emacs Lisp. expression, more fundamental but less pretty. * Primitive Function Type:: A function written in C, callable from Lisp. * Byte-Code Type:: A function written in Lisp, then compiled. +* Record Type:: Compound objects with programmer-defined types. * Autoload Type:: A type used for automatically loading seldom-used functions. * Finalizer Type:: Runs code when no longer reachable. @@ -1347,6 +1349,16 @@ The printed representation and read syntax for a byte-code function object is like that for a vector, with an additional @samp{#} before the opening @samp{[}. +@node Record Type +@subsection Record Type + + A @dfn{record} is much like a @code{vector}. However, the first +element is used to hold its type as returned by @code{type-of}. The +purpose of records is to allow programmers to create objects with new +types that are not built into Emacs. + + @xref{Records}, for functions that work with records. + @node Autoload Type @subsection Autoload Type @@ -1959,6 +1971,9 @@ with references to further information. @item processp @xref{Processes, processp}. +@item recordp +@xref{Record Type, recordp}. + @item sequencep @xref{Sequence Functions, sequencep}. @@ -2022,6 +2037,7 @@ This function returns a symbol naming the primitive type of @code{marker}, @code{mutex}, @code{overlay}, @code{process}, @code{string}, @code{subr}, @code{symbol}, @code{thread}, @code{vector}, @code{window}, or @code{window-configuration}. +However, if @var{object} is a record, its first slot is returned. @example (type-of 1) @@ -2033,6 +2049,8 @@ This function returns a symbol naming the primitive type of @result{} symbol (type-of '(x)) @result{} cons +(type-of (record 'foo)) + @result{} foo @end group @end example @end defun diff --git a/doc/lispref/records.texi b/doc/lispref/records.texi new file mode 100644 index 00000000000..aeba77a70e7 --- /dev/null +++ b/doc/lispref/records.texi @@ -0,0 +1,98 @@ +@c -*-texinfo-*- +@c This is part of the GNU Emacs Lisp Reference Manual. +@c Copyright (C) 2017 Free Software +@c Foundation, Inc. +@c See the file elisp.texi for copying conditions. +@node Records +@chapter Records +@cindex record + + The purpose of records is to allow programmers to create objects +with new types that are not built into Emacs. + + Internally, a record object is much like a vector; its slots can be +accessed using @code{aref}. However, the first slot is used to hold +its type as returned by @code{type-of}. Like arrays, records use +zero-origin indexing: the first slot has index 0. + + The printed representation of records is @samp{#s} followed by a +list specifying the contents. The first list element must be the +record type. The following elements are the record slots. + + A record is considered a constant for evaluation: the result of +evaluating it is the same record. This does not evaluate or even +examine the slots. @xref{Self-Evaluating Forms}. + +@menu +* Record Functions:: Functions for records. +@end menu + +@node Record Functions +@section Record Functions + +@defun recordp object +This function returns @code{t} if @var{object} is a record. + +@example +@group +(recordp #s(a)) + @result{} t +@end group +@end example +@end defun + +@defun record type &rest objects +This function creates and returns a record whose type is @var{type} +and remaining slots are the rest of the arguments, @var{objects}. + +@example +@group +(vector 'foo 23 [bar baz] "rats") + @result{} #s(foo 23 [bar baz] "rats") +@end group +@end example +@end defun + +@defun make-record type length object +This function returns a new record with type @var{type} and +@var{length} more slots, each initialized to @var{object}. + +@example +@group +(setq sleepy (make-record 'foo 9 'Z)) + @result{} #s(foo Z Z Z Z Z Z Z Z Z) +@end group +@end example +@end defun + +@defun copy-record record +This function returns a shallow copy of @var{record}. The copy is the +same type as the original record, and it has the same slots in the +same order. + + Storing a new slot into the copy does not affect the original +@var{record}, and vice versa. However, the slots of the new record +are not copies; they are identical (@code{eq}) to the slots of the +original. Therefore, changes made within these slots, as found via +the copied record, are also visible in the original record. + +@example +@group +(setq x (record 'foo 1 2)) + @result{} #s(foo 1 2) +@end group +@group +(setq y (copy-record x)) + @result{} #s(foo 1 2) +@end group + +@group +(eq x y) + @result{} nil +@end group +@group +(equal x y) + @result{} t +@end group +@end example +@end defun diff --git a/src/alloc.c b/src/alloc.c index ae3e1519c04..fe631f2e4d8 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3392,6 +3392,94 @@ allocate_buffer (void) return b; } + +/* Allocate a new record with COUNT slots. Return NULL if COUNT is + too large. */ + +static struct Lisp_Vector * +allocate_record (int count) +{ + if (count >= (1 << PSEUDOVECTOR_SIZE_BITS)) + return NULL; + + struct Lisp_Vector *p = allocate_vector (count); + XSETPVECTYPE (p, PVEC_RECORD); + return p; +} + + +DEFUN ("make-record", Fmake_record, Smake_record, 3, 3, 0, + doc: /* Create a new record. +TYPE is its type as returned by `type-of'. SLOTS is the number of +slots, each initialized to INIT. The number of slots, including the +type slot, must fit in PSEUDOVECTOR_SIZE_BITS. */) + (Lisp_Object type, Lisp_Object slots, Lisp_Object init) +{ + Lisp_Object record; + ptrdiff_t size, i; + struct Lisp_Vector *p; + + CHECK_NATNUM (slots); + + size = XFASTINT (slots) + 1; + p = allocate_record (size); + if (p == NULL) + error ("Attempt to allocate a record of %ld slots; max is %d", + size, (1 << PSEUDOVECTOR_SIZE_BITS) - 1); + + p->contents[0] = type; + for (i = 1; i < size; i++) + p->contents[i] = init; + + XSETVECTOR (record, p); + return record; +} + + +DEFUN ("record", Frecord, Srecord, 1, MANY, 0, + doc: /* Create a new record. +TYPE is its type as returned by `type-of'. SLOTS is used to +initialize the record slots with shallow copies of the arguments. The +number of slots, including the type slot, must fit in +PSEUDOVECTOR_SIZE_BITS. +usage: (record TYPE &rest SLOTS) */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + struct Lisp_Vector *p = allocate_record (nargs); + if (p == NULL) + error ("Attempt to allocate a record of %ld slots; max is %d", + nargs, (1 << PSEUDOVECTOR_SIZE_BITS) - 1); + + Lisp_Object type = args[0]; + Lisp_Object record; + + p->contents[0] = type; + memcpy (p->contents + 1, args + 1, (nargs - 1) * sizeof *args); + + XSETVECTOR (record, p); + return record; +} + + +DEFUN ("copy-record", Fcopy_record, Scopy_record, 1, 1, 0, + doc: /* Return a new record that is a shallow copy of the argument RECORD. */) + (Lisp_Object record) +{ + CHECK_RECORD (record); + struct Lisp_Vector *src = XVECTOR (record); + ptrdiff_t size = ASIZE (record) & PSEUDOVECTOR_SIZE_MASK; + struct Lisp_Vector *new = allocate_record (size); + if (new == NULL) + error ("Attempt to allocate a record of %ld slots; max is %d", + size, (1 << PSEUDOVECTOR_SIZE_BITS) - 1); + + memcpy (&(new->contents[0]), &(src->contents[0]), + size * sizeof (Lisp_Object)); + XSETVECTOR (record, new); + return record; +} + + 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'. */) @@ -5532,7 +5620,7 @@ purecopy (Lisp_Object obj) struct Lisp_Hash_Table *h = purecopy_hash_table (table); XSET_HASH_TABLE (obj, h); } - else if (COMPILEDP (obj) || VECTORP (obj)) + else if (COMPILEDP (obj) || VECTORP (obj) || RECORDP (obj)) { struct Lisp_Vector *objp = XVECTOR (obj); ptrdiff_t nbytes = vector_nbytes (objp); @@ -7461,10 +7549,13 @@ The time is in seconds as a floating point value. */); defsubr (&Scons); defsubr (&Slist); defsubr (&Svector); + defsubr (&Srecord); + defsubr (&Scopy_record); defsubr (&Sbool_vector); defsubr (&Smake_byte_code); defsubr (&Smake_list); defsubr (&Smake_vector); + defsubr (&Smake_record); defsubr (&Smake_string); defsubr (&Smake_bool_vector); defsubr (&Smake_symbol); diff --git a/src/data.c b/src/data.c index ae8dd9721c2..5fdbec2000e 100644 --- a/src/data.c +++ b/src/data.c @@ -267,6 +267,15 @@ for example, (type-of 1) returns `integer'. */) case PVEC_MUTEX: return Qmutex; case PVEC_CONDVAR: return Qcondition_variable; case PVEC_TERMINAL: return Qterminal; + case PVEC_RECORD: + { + Lisp_Object t = AREF (object, 0); + if (RECORDP (t) && 1 < (ASIZE (t) & PSEUDOVECTOR_SIZE_MASK)) + /* Return the type name field of the class! */ + return AREF (t, 1); + else + return t; + } /* "Impossible" cases. */ case PVEC_XWIDGET: case PVEC_OTHER: @@ -359,6 +368,15 @@ DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0, return Qnil; } +DEFUN ("recordp", Frecordp_p, Srecordp, 1, 1, 0, + doc: /* Return t if OBJECT is a record. */) + (Lisp_Object object) +{ + if (RECORDP (object)) + return Qt; + return Qnil; +} + DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0, doc: /* Return t if OBJECT is a string. */ attributes: const) @@ -2287,7 +2305,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) || RECORDP (array)) size = ASIZE (array) & PSEUDOVECTOR_SIZE_MASK; else wrong_type_argument (Qarrayp, array); @@ -2308,7 +2326,8 @@ bool-vector. IDX starts at 0. */) CHECK_NUMBER (idx); idxval = XINT (idx); - CHECK_ARRAY (array, Qarrayp); + if (! RECORDP (array)) + CHECK_ARRAY (array, Qarrayp); if (VECTORP (array)) { @@ -2328,7 +2347,14 @@ bool-vector. IDX starts at 0. */) CHECK_CHARACTER (idx); CHAR_TABLE_SET (array, idxval, newelt); } - else + else if (RECORDP (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; @@ -3604,6 +3630,7 @@ syms_of_data (void) DEFSYM (Qsequencep, "sequencep"); DEFSYM (Qbufferp, "bufferp"); DEFSYM (Qvectorp, "vectorp"); + DEFSYM (Qrecordp, "recordp"); DEFSYM (Qbool_vector_p, "bool-vector-p"); DEFSYM (Qchar_or_string_p, "char-or-string-p"); DEFSYM (Qmarkerp, "markerp"); @@ -3714,6 +3741,7 @@ syms_of_data (void) DEFSYM (Qbuffer, "buffer"); DEFSYM (Qframe, "frame"); DEFSYM (Qvector, "vector"); + DEFSYM (Qrecord, "record"); DEFSYM (Qchar_table, "char-table"); DEFSYM (Qbool_vector, "bool-vector"); DEFSYM (Qhash_table, "hash-table"); @@ -3750,6 +3778,7 @@ syms_of_data (void) defsubr (&Sstringp); defsubr (&Smultibyte_string_p); defsubr (&Svectorp); + defsubr (&Srecordp); defsubr (&Schar_table_p); defsubr (&Svector_or_char_table_p); defsubr (&Sbool_vector_p); diff --git a/src/fns.c b/src/fns.c index de7fc1b47fc..47da5f8b4bc 100644 --- a/src/fns.c +++ b/src/fns.c @@ -106,7 +106,7 @@ To get the number of bytes, use `string-bytes'. */) XSETFASTINT (val, MAX_CHAR); else if (BOOL_VECTOR_P (sequence)) XSETFASTINT (val, bool_vector_size (sequence)); - else if (COMPILEDP (sequence)) + else if (COMPILEDP (sequence) || RECORDP (sequence)) XSETFASTINT (val, ASIZE (sequence) & PSEUDOVECTOR_SIZE_MASK); else if (CONSP (sequence)) { diff --git a/src/lisp.h b/src/lisp.h index 3125bd2a5dd..5e7d41bc5d5 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -889,6 +889,7 @@ enum pvec_type PVEC_COMPILED, PVEC_CHAR_TABLE, PVEC_SUB_CHAR_TABLE, + PVEC_RECORD, PVEC_FONT /* Should be last because it's used for range checking. */ }; @@ -1412,6 +1413,7 @@ CHECK_VECTOR (Lisp_Object x) CHECK_TYPE (VECTORP (x), Qvectorp, x); } + /* A pseudovector is like a vector, but has other non-Lisp components. */ INLINE enum pvec_type @@ -2732,6 +2734,18 @@ FRAMEP (Lisp_Object a) return PSEUDOVECTORP (a, PVEC_FRAME); } +INLINE bool +RECORDP (Lisp_Object a) +{ + return PSEUDOVECTORP (a, PVEC_RECORD); +} + +INLINE void +CHECK_RECORD (Lisp_Object x) +{ + CHECK_TYPE (RECORDP (x), Qrecordp, x); +} + /* Test for image (image . spec) */ INLINE bool IMAGEP (Lisp_Object x) diff --git a/src/lread.c b/src/lread.c index 5c6a7f97f52..6de9fe6e08e 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2603,8 +2603,18 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) int param_count = 0; if (!EQ (head, Qhash_table)) - error ("Invalid extended read marker at head of #s list " - "(only hash-table allowed)"); + { + ptrdiff_t size = XINT (Flength (tmp)); + Lisp_Object record = Fmake_record (CAR_SAFE (tmp), + make_number (size - 1), + Qnil); + for (int i = 1; i < size; i++) + { + tmp = Fcdr (tmp); + ASET (record, i, Fcar (tmp)); + } + return record; + } tmp = CDR_SAFE (tmp); diff --git a/src/print.c b/src/print.c index e857761bd46..76f263994e6 100644 --- a/src/print.c +++ b/src/print.c @@ -1135,7 +1135,8 @@ print (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) || (VECTORLIKEP (obj) \ && (VECTORP (obj) || COMPILEDP (obj) \ || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) \ - || HASH_TABLE_P (obj) || FONTP (obj))) \ + || HASH_TABLE_P (obj) || FONTP (obj) \ + || RECORDP (obj))) \ || (! NILP (Vprint_gensym) \ && SYMBOLP (obj) \ && !SYMBOL_INTERNED_P (obj))) @@ -1963,6 +1964,30 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) } break; + case PVEC_RECORD: + { + ptrdiff_t n, size = ASIZE (obj) & PSEUDOVECTOR_SIZE_MASK; + int i; + + /* Don't print more elements than the specified maximum. */ + if (NATNUMP (Vprint_length) + && XFASTINT (Vprint_length) < size) + n = XFASTINT (Vprint_length); + else + n = size; + + print_c_string ("#s(", printcharfun); + for (i = 0; i < n; i ++) + { + if (i) printchar (' ', printcharfun); + print_object (AREF (obj, i), printcharfun, escapeflag); + } + if (n < size) + print_c_string (" ...", printcharfun); + printchar (')', printcharfun); + } + break; + case PVEC_SUB_CHAR_TABLE: case PVEC_COMPILED: case PVEC_CHAR_TABLE: diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el index 04ddfeeca8a..772601fe87d 100644 --- a/test/lisp/emacs-lisp/cl-print-tests.el +++ b/test/lisp/emacs-lisp/cl-print-tests.el @@ -37,4 +37,14 @@ (should (string-match "\\`#f(compiled-function (x) .*\n\n.*)\\'" (cl-prin1-to-string (symbol-function #'caar)))))) +(ert-deftest cl-print-tests-2 () + (let ((x (record 'foo 1 2 3))) + (should (equal + x + (car (read-from-string (with-output-to-string (prin1 x)))))) + (let ((print-circle t)) + (should (string-match + "\\`(#1=#s(foo 1 2 3) #1#)\\'" + (cl-prin1-to-string (list x x))))))) + ;;; cl-print-tests.el ends here. diff --git a/test/src/alloc-tests.el b/test/src/alloc-tests.el index af4ad6c6355..8b4ef8ce7d2 100644 --- a/test/src/alloc-tests.el +++ b/test/src/alloc-tests.el @@ -31,3 +31,23 @@ (ert-deftest finalizer-object-type () (should (equal (type-of (make-finalizer nil)) 'finalizer))) + +(ert-deftest record-1 () + (let ((x (record 'foo 1 2 3))) + (should (recordp x)) + (should (eq (type-of x) 'foo)) + (should (eq (aref x 0) 'foo)) + (should (eql (aref x 3) 3)) + (should (eql (length x) 4)))) + +(ert-deftest record-2 () + (let ((x (make-record 'bar 1 0))) + (should (eql (length x) 2)) + (should (eql (aref x 1) 0)))) + +(ert-deftest record-3 () + (let* ((x (record 'foo 1 2 3)) + (y (copy-record x))) + (should-not (eq x y)) + (dotimes (i 4) + (should (eql (aref x i) (aref y i)))))) |