diff options
author | Lars Brinkhoff <lars@nocrew.org> | 2013-01-06 14:27:44 +0100 |
---|---|---|
committer | Lars Brinkhoff <lars@nocrew.org> | 2017-04-04 08:23:46 +0200 |
commit | a2c33430292c79ac520100b1d0e8e7c04dfe426a (patch) | |
tree | c14abd179a8646449c1430f24762db3e2359886a /src/data.c | |
parent | 19b92cdfb04a025037d7388954b64468d6f54462 (diff) | |
download | emacs-a2c33430292c79ac520100b1d0e8e7c04dfe426a.tar.gz |
Add record objects with user-defined types.
* src/alloc.c (allocate_record): New function.
(Fmake_record, Frecord, Fcopy_record): New functions.
(syms_of_alloc): defsubr them.
(purecopy): Work with records.
* src/data.c (Ftype_of): Return slot 0 for record objects, or type
name if record's type holds class.
(Frecordp): New function.
(syms_of_data): defsubr it. Define `Qrecordp'.
(Faref, Faset): Work with records.
* src/fns.c (Flength): Work with records.
* src/lisp.h (prec_type): Add PVEC_RECORD.
(RECORDP, CHECK_RECORD, CHECK_RECORD_TYPE): New functions.
* src/lread.c (read1): Add syntax for records.
* src/print.c (PRINT_CIRCLE_CANDIDATE_P): Add RECORDP.
(print_object): Add syntax for records.
* test/lisp/emacs-lisp/cl-print-tests.el (cl-print-tests-2):
New test.
* test/src/alloc-tests.el (record-1, record-2, record-3):
New tests.
* doc/lispref/elisp.texi, doc/lispref/objects.texi,
doc/lispref/records.texi: Add documentation for records.
Diffstat (limited to 'src/data.c')
-rw-r--r-- | src/data.c | 35 |
1 files changed, 32 insertions, 3 deletions
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); |