[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] scratch/record 454458a 1/4: Add record objects with user-d
|
From: |
Lars Brinkhoff |
|
Subject: |
[Emacs-diffs] scratch/record 454458a 1/4: Add record objects with user-defined types. |
|
Date: |
Wed, 15 Mar 2017 17:49:17 -0400 (EDT) |
branch: scratch/record
commit 454458a9e1c56a2578a6cc7abb43251660c665e2
Author: Lars Brinkhoff <address@hidden>
Commit: Lars Brinkhoff <address@hidden>
Add record objects with user-defined types.
---
src/alloc.c | 58 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
src/data.c | 28 +++++++++++++++++++++++++---
src/fns.c | 2 +-
src/lisp.h | 14 ++++++++++++++
src/lread.c | 13 +++++++++++++
src/print.c | 7 +++++++
6 files changed, 117 insertions(+), 5 deletions(-)
diff --git a/src/alloc.c b/src/alloc.c
index ae3e151..f7dd934 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3392,6 +3392,60 @@ allocate_buffer (void)
return b;
}
+
+static struct Lisp_Vector *
+allocate_record (int count)
+{
+ if (count >= (1 << PSEUDOVECTOR_SIZE_BITS))
+ error ("Record too large");
+
+ 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 of type TYPE with SLOTS elements, each
initialized to INIT. */)
+ (Lisp_Object type, Lisp_Object slots, Lisp_Object init)
+{
+ Lisp_Object record;
+ ptrdiff_t size, i;
+ struct Lisp_Vector *p;
+
+ CHECK_RECORD_TYPE (type);
+ CHECK_NATNUM (slots);
+
+ size = XFASTINT (slots) + 1;
+ p = allocate_record (size);
+ 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: /* Return a newly created record of type TYPE the rest of the
arguments as slots.
+Any number of slots, even zero slots, are allowed.
+usage: (record TYPE &rest SLOTS) */)
+ (ptrdiff_t nargs, Lisp_Object *args)
+{
+ struct Lisp_Vector *p = allocate_record (nargs);
+ Lisp_Object type = args[0];
+ Lisp_Object record;
+
+ CHECK_RECORD_TYPE (type);
+ p->contents[0] = type;
+ memcpy (p->contents + 1, args + 1, (nargs - 1) * sizeof *args);
+
+ XSETVECTOR (record, p);
+ 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 +5586,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 +7515,12 @@ The time is in seconds as a floating point value. */);
defsubr (&Scons);
defsubr (&Slist);
defsubr (&Svector);
+ defsubr (&Srecord);
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 ae8dd97..e3998b6 100644
--- a/src/data.c
+++ b/src/data.c
@@ -267,6 +267,7 @@ 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: return AREF (object, 0);
/* "Impossible" cases. */
case PVEC_XWIDGET:
case PVEC_OTHER:
@@ -359,6 +360,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 +2297,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 +2318,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 +2339,16 @@ 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);
+ if (idxval == 0)
+ CHECK_RECORD_TYPE (newelt);
+ ASET (array, idxval, newelt);
+ }
+ else /* STRINGP */
{
int c;
@@ -3714,6 +3734,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 +3771,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 1065355..36bde20 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -104,7 +104,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 ab4db4c..4f3ab35 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -874,6 +874,7 @@ enum pvec_type
PVEC_TERMINAL,
PVEC_WINDOW_CONFIGURATION,
PVEC_SUBR,
+ PVEC_RECORD,
PVEC_OTHER, /* Should never be visible to Elisp code. */
PVEC_XWIDGET,
PVEC_XWIDGET_VIEW,
@@ -1408,6 +1409,13 @@ CHECK_VECTOR (Lisp_Object x)
CHECK_TYPE (VECTORP (x), Qvectorp, x);
}
+INLINE void
+CHECK_RECORD_TYPE (Lisp_Object x)
+{
+ CHECK_SYMBOL (x);
+}
+
+
/* A pseudovector is like a vector, but has other non-Lisp components. */
INLINE enum pvec_type
@@ -2728,6 +2736,12 @@ FRAMEP (Lisp_Object a)
return PSEUDOVECTORP (a, PVEC_FRAME);
}
+INLINE bool
+RECORDP (Lisp_Object a)
+{
+ return PSEUDOVECTORP (a, PVEC_RECORD);
+}
+
/* Test for image (image . spec) */
INLINE bool
IMAGEP (Lisp_Object x)
diff --git a/src/lread.c b/src/lread.c
index 5c6a7f9..1fcbc37 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -2762,6 +2762,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_RECORD);
+ return tmp;
+ }
+ UNREAD (c);
+ invalid_syntax ("#");
+ }
if (c == '(')
{
Lisp_Object tmp;
diff --git a/src/print.c b/src/print.c
index e857761..f7ecd3c 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1966,6 +1966,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun,
bool escapeflag)
case PVEC_SUB_CHAR_TABLE:
case PVEC_COMPILED:
case PVEC_CHAR_TABLE:
+ case PVEC_RECORD:
case PVEC_NORMAL_VECTOR: ;
{
ptrdiff_t size = ASIZE (obj);
@@ -1974,6 +1975,12 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun,
bool escapeflag)
printchar ('#', printcharfun);
size &= PSEUDOVECTOR_SIZE_MASK;
}
+ if (RECORDP (obj))
+ {
+ printchar ('#', printcharfun);
+ printchar ('%', printcharfun);
+ 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,