[Emacs-diffs] scratch/record 0013635 06/10: Change read/print syntax to use #s.

[Lars Brinkhoff]

branch: scratch/record
commit 0013635a1a94fe954bad17b20e79de21930368e4
Author: Lars Brinkhoff <address@hidden>
Commit: Lars Brinkhoff <address@hidden>

    Change read/print syntax to use #s.
---
 doc/lispref/records.texi               | 16 ++++++++--------
 src/lread.c                            | 27 ++++++++++++---------------
 src/print.c                            | 31 ++++++++++++++++++++++++-------
 test/lisp/emacs-lisp/cl-print-tests.el |  2 +-
 4 files changed, 45 insertions(+), 31 deletions(-)

diff --git a/doc/lispref/records.texi b/doc/lispref/records.texi
index 3c4e015..224d747 100644
--- a/doc/lispref/records.texi
+++ b/doc/lispref/records.texi
@@ -17,9 +17,9 @@ 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 like that for a vector,
-with an additional @samp{#%} before the opening @samp{[}.  It must have
-at least one slot: the type.
+  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 records slots.
 
   A record is considered a constant for evaluation: the result of
 evaluating it is the same record.  This does not evaluate or even
@@ -38,7 +38,7 @@ This function returns @code{t} if @var{object} is a record.
 
 @example
 @group
-(recordp #%[a])
+(recordp #s(a))
      @result{} t
 @end group
 @end example
@@ -51,7 +51,7 @@ and remaining slots are the rest of thearguments, 
@var{objects}.
 @example
 @group
 (vector 'foo 23 [bar baz] "rats")
-     @result{} #%[foo 23 [bar baz] "rats"]
+     @result{} #s(foo 23 [bar baz] "rats")
 @end group
 @end example
 @end defun
@@ -63,7 +63,7 @@ This function returns a new record with type @var{type} and
 @example
 @group
 (setq sleepy (make-record 'foo 9 'Z))
-     @result{} #%[foo Z Z Z Z Z Z Z Z Z]
+     @result{} #s(foo Z Z Z Z Z Z Z Z Z)
 @end group
 @end example
 @end defun
@@ -82,11 +82,11 @@ the copied record, are also visible in the original record.
 @example
 @group
 (setq x (record 'foo 1 2))
-     @result{} #%[foo 1 2]
+     @result{} #s(foo 1 2)
 @end group
 @group
 (setq y (copy-record x))
-     @result{} #%[foo 1 2]
+     @result{} #s(foo 1 2)
 @end group
 
 @group
diff --git a/src/lread.c b/src/lread.c
index 1fcbc37..6de9fe6 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);
 
@@ -2762,19 +2772,6 @@ 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 402df03..76f2639 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1964,10 +1964,33 @@ 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:
-      case PVEC_RECORD:
       case PVEC_NORMAL_VECTOR: ;
        {
          ptrdiff_t size = ASIZE (obj);
@@ -1976,12 +1999,6 @@ 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,
diff --git a/test/lisp/emacs-lisp/cl-print-tests.el 
b/test/lisp/emacs-lisp/cl-print-tests.el
index 547dbe7..772601f 100644
--- a/test/lisp/emacs-lisp/cl-print-tests.el
+++ b/test/lisp/emacs-lisp/cl-print-tests.el
@@ -44,7 +44,7 @@
              (car (read-from-string (with-output-to-string (prin1 x))))))
     (let ((print-circle t))
       (should (string-match
-               "\\`(#1=.* #1#)\\'"
+               "\\`(#1=#s(foo 1 2 3) #1#)\\'"
                (cl-prin1-to-string (list x x)))))))
 
 ;;; cl-print-tests.el ends here.