unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* User-defined record types, v2
@ 2017-03-18 17:04 Lars Brinkhoff
  2017-03-18 17:05 ` Lars Brinkhoff
                   ` (3 more replies)
  0 siblings, 4 replies; 31+ messages in thread
From: Lars Brinkhoff @ 2017-03-18 17:04 UTC (permalink / raw)
  To: emacs-devel

These are the second version of the patches to implement record objects
with user-defined types.  They have been rebased on top of the latest
master, and pass a bootstrap build.  Also available as scratch/record2.




^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-18 17:04 User-defined record types, v2 Lars Brinkhoff
@ 2017-03-18 17:05 ` Lars Brinkhoff
  2017-03-18 17:13   ` Lars Brinkhoff
  2017-03-18 17:29   ` Eli Zaretskii
  2017-03-19 10:28 ` Lars Brinkhoff
                   ` (2 subsequent siblings)
  3 siblings, 2 replies; 31+ messages in thread
From: Lars Brinkhoff @ 2017-03-18 17:05 UTC (permalink / raw)
  To: emacs-devel

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.
(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_object): Add syntax for records.

diff --git a/src/alloc.c b/src/alloc.c
index ae3e151..14a179f 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3392,6 +3392,75 @@ struct buffer *
   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 ("copy-record", Fcopy_record, Scopy_record, 1, 1, 0,
+       doc: /* Shallow copy of a 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);
+  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 +5601,7 @@ struct marker_block
       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 +7530,13 @@ This means that certain objects should be allocated in shared (pure) space.
   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 ae8dd97..8e0bccc 100644
--- a/src/data.c
+++ b/src/data.c
@@ -267,6 +267,7 @@ static void swap_in_symval_forwarding (struct Lisp_Symbol *,
         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 @@ static void swap_in_symval_forwarding (struct Lisp_Symbol *,
   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 @@ If the current binding is global (the default), the value is nil.  */)
       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 @@ If the current binding is global (the default), the value is nil.  */)
 
   CHECK_NUMBER (idx);
   idxval = XINT (idx);
-  CHECK_ARRAY (array, Qarrayp);
+  if (! RECORDP (array))
+    CHECK_ARRAY (array, Qarrayp);
 
   if (VECTORP (array))
     {
@@ -2328,7 +2339,16 @@ If the current binding is global (the default), the value is nil.  */)
       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;
 
@@ -3604,6 +3624,7 @@ enum bool_vector_op { bool_vector_exclusive_or,
   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 +3735,7 @@ enum bool_vector_op { bool_vector_exclusive_or,
   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 +3772,7 @@ enum bool_vector_op { bool_vector_exclusive_or,
   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 @@ static void sort_vector_copy (Lisp_Object, ptrdiff_t,
     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..d3793ac 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,7 @@ struct Lisp_Vector
   CHECK_TYPE (VECTORP (x), Qvectorp, x);
 }
 
+
 /* A pseudovector is like a vector, but has other non-Lisp components.  */
 
 INLINE enum pvec_type
@@ -2728,6 +2730,24 @@ enum char_bits
   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);
+}
+
+INLINE void
+CHECK_RECORD_TYPE (Lisp_Object x)
+{
+  /* CHECK_SYMBOL (x); */
+}
+
 /* 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 @@ BUFFER is the buffer to evaluate (nil means use current buffer),
 	  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 @@
       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 @@
 	      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,




^ permalink raw reply related	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-18 17:05 ` Lars Brinkhoff
@ 2017-03-18 17:13   ` Lars Brinkhoff
  2017-03-18 17:17     ` Lars Brinkhoff
  2017-03-18 17:29   ` Eli Zaretskii
  1 sibling, 1 reply; 31+ messages in thread
From: Lars Brinkhoff @ 2017-03-18 17:13 UTC (permalink / raw)
  To: emacs-devel

Update cl-defstruct to use records.

* lisp/emacs-lisp/cl-generic.el (cl--generic-struct-tag): Use type-of.
(cl--generic-struct-specializers): Adjust to new tag.

* lisp/emacs-lisp/cl-macs.el (cl-defstruct): Use type=nil as before.
Use the type symbol as the tag.  Use copy-record to copy structs.
(cl--defstruct-predicate): New function.
(cl--pcase-mutually-exclusive-p): Use it.
(cl-struct-sequence-type): Can now return `record'.

* lisp/emacs-lisp/cl-preloaded.el (cl--make-slot-desc): Adjust ad-hoc
code to new format.
(cl--struct-register-child): Work with records.
(cl-struct-define): Don't touch the tag's symbol-value and
symbol-function slots when we use the type as tag.

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 8c6d3d5..e15c942 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1082,24 +1082,8 @@ cl--generic-eql-used
 ;;; Support for cl-defstructs specializers.
 
 (defun cl--generic-struct-tag (name &rest _)
-  ;; It's tempting to use (and (vectorp ,name) (aref ,name 0))
-  ;; but that would suffer from some problems:
-  ;; - the vector may have size 0.
-  ;; - when called on an actual vector (rather than an object), we'd
-  ;;   end up returning an arbitrary value, possibly colliding with
-  ;;   other tagcode's values.
-  ;; - it can also result in returning all kinds of irrelevant
-  ;;   values which would end up filling up the method-cache with
-  ;;   lots of irrelevant/redundant entries.
-  ;; FIXME: We could speed this up by introducing a dedicated
-  ;; vector type at the C level, so we could do something like
-  ;; (and (vector-objectp ,name) (aref ,name 0))
-  `(and (vectorp ,name)
-        (> (length ,name) 0)
-        (let ((tag (aref ,name 0)))
-          (and (symbolp tag)
-               (eq (symbol-function tag) :quick-object-witness-check)
-               tag))))
+  ;; Use exactly the same code as for `typeof'.
+  `(if ,name (type-of ,name) 'null))
 
 (defun cl--generic-class-parents (class)
   (let ((parents ())
@@ -1113,8 +1097,8 @@ cl--generic-class-parents
     (nreverse parents)))
 
 (defun cl--generic-struct-specializers (tag &rest _)
-  (and (symbolp tag) (boundp tag)
-       (let ((class (symbol-value tag)))
+  (and (symbolp tag)
+       (let ((class (get tag 'cl--class)))
          (when (cl-typep class 'cl-structure-class)
            (cl--generic-class-parents class)))))
 
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 40342f3..7e08ca2 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2604,11 +2604,24 @@ cl-defstruct
 	 (print-func nil) (print-auto nil)
 	 (safety (if (cl--compiling-file) cl--optimize-safety 3))
 	 (include nil)
-	 (tag (intern (format "cl-struct-%s" name)))
+         ;; There are 4 types of structs:
+         ;; - `vector' type: means we should use a vector, which can come
+         ;;   with or without a tag `name', which is usually in slot 0
+         ;;   but obeys :initial-offset.
+         ;; - `list' type: same as `vector' but using lists.
+         ;; - `record' type: means we should use a record, which necessarily
+         ;;   comes tagged in slot 0.  Currently we'll use the `name' as
+         ;;   the tag, but we may want to change it so that the class object
+         ;;   is used as the tag.
+         ;; - nil type: this is the "pre-record default", which uses a vector
+         ;;   with a tag in slot 0 which is a symbol of the form
+         ;;   `cl-struct-NAME'.  We need to still support this for backward
+         ;;   compatibility with old .elc files.
+	 (tag name)
 	 (tag-symbol (intern (format "cl-struct-%s-tags" name)))
 	 (include-descs nil)
 	 (include-name nil)
-	 (type nil)
+	 (type nil)         ;nil here means not specified explicitly.
 	 (named nil)
 	 (forms nil)
          (docstring (if (stringp (car descs)) (pop descs)))
@@ -2648,7 +2661,9 @@ cl-defstruct
 	      ((eq opt :print-function)
 	       (setq print-func (car args)))
 	      ((eq opt :type)
-	       (setq type (car args)))
+	       (setq type (car args))
+               (unless (memq type '(vector list))
+                 (error "Invalid :type specifier: %s" type)))
 	      ((eq opt :named)
 	       (setq named t))
 	      ((eq opt :initial-offset)
@@ -2680,13 +2695,11 @@ cl-defstruct
 		    (pop include-descs)))
 	  (setq descs (append old-descs (delq (assq 'cl-tag-slot descs) descs))
 		type inc-type
-		named (if type (assq 'cl-tag-slot descs) 'true))
-	  (if (cl--struct-class-named include) (setq tag name named t)))
-      (if type
-	  (progn
-	    (or (memq type '(vector list))
-		(error "Invalid :type specifier: %s" type))
-	    (if named (setq tag name)))
+		named (if (memq type '(vector list))
+                          (assq 'cl-tag-slot descs)
+                        'true))
+	  (if (cl--struct-class-named include) (setq named t)))
+      (unless type
 	(setq named 'true)))
     (or named (setq descs (delq (assq 'cl-tag-slot descs) descs)))
     (when (and (null predicate) named)
@@ -2696,7 +2709,9 @@ cl-defstruct
 				       (length (memq (assq 'cl-tag-slot descs)
 						     descs)))))
 			   (cond
-                            ((memq type '(nil vector))
+                            ((null type) ;Record type.
+                             `(memq (type-of cl-x) ,tag-symbol))
+                            ((eq type 'vector)
                              `(and (vectorp cl-x)
                                    (>= (length cl-x) ,(length descs))
                                    (memq (aref cl-x ,pos) ,tag-symbol)))
@@ -2793,7 +2808,9 @@ cl-defstruct
     (setq slots (nreverse slots)
 	  defaults (nreverse defaults))
     (and copier
-         (push `(defalias ',copier #'copy-sequence) forms))
+         (push `(defalias ',copier
+                    ,(if (null type) '#'copy-record '#'copy-sequence))
+               forms))
     (if constructor
 	(push (list constructor
                     (cons '&key (delq nil (copy-sequence slots))))
@@ -2808,7 +2825,7 @@ cl-defstruct
                     (format "Constructor for objects of type `%s'." name))
                  ,@(if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs)))
                        '((declare (side-effect-free t))))
-                 (,(or type #'vector) ,@make))
+                 (,(or type #'record) ,@make))
               forms)))
     (if print-auto (nconc print-func (list '(princ ")" cl-s) t)))
     ;; Don't bother adding to cl-custom-print-functions since it's not used
@@ -2866,6 +2883,15 @@ cl--struct-all-parents
                      ,pat)))
            fields)))
 
+(defun cl--defstruct-predicate (type)
+  (let ((cons (assq (cl-struct-sequence-type type)
+                    `((list . consp)
+                      (vector . vectorp)
+                      (nil . recordp)))))
+    (if cons
+        (cdr cons)
+      'recordp)))
+
 (defun cl--pcase-mutually-exclusive-p (orig pred1 pred2)
   "Extra special cases for `cl-typep' predicates."
   (let* ((x1 pred1) (x2 pred2)
@@ -2888,14 +2914,12 @@ cl--pcase-mutually-exclusive-p
                           (memq c2 (cl--struct-all-parents c1)))))))
      (let ((c1 (and (symbolp t1) (cl--find-class t1))))
        (and c1 (cl--struct-class-p c1)
-            (funcall orig (if (eq 'list (cl-struct-sequence-type t1))
-                              'consp 'vectorp)
+            (funcall orig (cl--defstruct-predicate t1)
                      pred2)))
      (let ((c2 (and (symbolp t2) (cl--find-class t2))))
        (and c2 (cl--struct-class-p c2)
             (funcall orig pred1
-                     (if (eq 'list (cl-struct-sequence-type t2))
-                         'consp 'vectorp))))
+                     (cl--defstruct-predicate t2))))
      (funcall orig pred1 pred2))))
 (advice-add 'pcase--mutually-exclusive-p
             :around #'cl--pcase-mutually-exclusive-p)
@@ -2903,8 +2927,8 @@ cl--pcase-mutually-exclusive-p
 
 (defun cl-struct-sequence-type (struct-type)
   "Return the sequence used to build STRUCT-TYPE.
-STRUCT-TYPE is a symbol naming a struct type.  Return `vector' or
-`list', or nil if STRUCT-TYPE is not a struct type. "
+STRUCT-TYPE is a symbol naming a struct type.  Return `record',
+`vector`, or `list' if STRUCT-TYPE is a struct type, nil otherwise."
   (declare (side-effect-free t) (pure t))
   (cl--struct-class-type (cl--struct-get-class struct-type)))
 
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index bba7b83..bd77654 100644
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -64,7 +64,7 @@ cl-struct-cl-structure-object-tags
       ;; cl--slot-descriptor.
       ;; BEWARE: Obviously, it's important to keep the two in sync!
       (lambda (name &optional initform type props)
-        (vector 'cl-struct-cl-slot-descriptor
+        (record 'cl-slot-descriptor
                 name initform type props)))
 
 (defun cl--struct-get-class (name)
@@ -101,7 +101,7 @@ cl--plist-remove
 (defun cl--struct-register-child (parent tag)
   ;; Can't use (cl-typep parent 'cl-structure-class) at this stage
   ;; because `cl-structure-class' is defined later.
-  (while (vectorp parent)
+  (while (recordp parent)
     (add-to-list (cl--struct-class-children-sym parent) tag)
     ;; Only register ourselves as a child of the leftmost parent since structs
     ;; can only only have one parent.
@@ -150,7 +150,7 @@ cl-struct-define
                    parent name))))
     (add-to-list 'current-load-list `(define-type . ,name))
     (cl--struct-register-child parent-class tag)
-    (unless (eq named t)
+    (unless (or (eq named t) (eq tag name))
       ;; We used to use `defconst' instead of `set' but that
       ;; has a side-effect of purecopying during the dump, so that the
       ;; class object stored in the tag ends up being a *copy* of the




^ permalink raw reply related	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-18 17:13   ` Lars Brinkhoff
@ 2017-03-18 17:17     ` Lars Brinkhoff
  2017-03-18 17:21       ` Lars Brinkhoff
  0 siblings, 1 reply; 31+ messages in thread
From: Lars Brinkhoff @ 2017-03-18 17:17 UTC (permalink / raw)
  To: emacs-devel

Make EIEIO use records.

* lisp/emacs-lisp/eieio-core.el: Use records, and place the class object
directly as tag.
(eieio--object-class): Adjust to new tag representation.
(eieio-object-p): Rewrite.
(eieio-defclass-internal): Use `make-record'.
(eieio--generic-generalizer): Adjust generalizer code accordingly.

* lisp/emacs-lisp/eieio.el (make-instance, clone): Use copy-record.

* lisp/emacs-lisp/pcase.el (pcase-mutually-exclusive-predicates):
Add `recordp'.

diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index 5cc6d02..882e7fb 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -122,7 +122,7 @@ eieio-default-superclass
     (length (cl-struct-slot-info 'eieio--object))))
 
 (defsubst eieio--object-class (obj)
-  (symbol-value (eieio--object-class-tag obj)))
+  (eieio--object-class-tag obj))
 
 \f
 ;;; Important macros used internally in eieio.
@@ -166,13 +166,7 @@ eieio--class-option
 
 (defun eieio-object-p (obj)
   "Return non-nil if OBJ is an EIEIO object."
-  (and (vectorp obj)
-       (> (length obj) 0)
-       (let ((tag (eieio--object-class-tag obj)))
-         (and (symbolp tag)
-              ;; (eq (symbol-function tag) :quick-object-witness-check)
-              (boundp tag)
-              (eieio--class-p (symbol-value tag))))))
+  (eieio--class-p (type-of obj)))
 
 (define-obsolete-function-alias 'object-p 'eieio-object-p "25.1")
 
@@ -496,18 +490,10 @@ eieio-defclass-internal
     (if clearparent (setf (eieio--class-parents newc) nil))
 
     ;; Create the cached default object.
-    (let ((cache (make-vector (+ (length (eieio--class-slots newc))
+    (let ((cache (make-record newc
+                              (+ (length (eieio--class-slots newc))
                                  (eval-when-compile eieio--object-num-slots))
-                              nil))
-          ;; We don't strictly speaking need to use a symbol, but the old
-          ;; code used the class's name rather than the class's object, so
-          ;; we follow this preference for using a symbol, which is probably
-          ;; convenient to keep the printed representation of such Elisp
-          ;; objects readable.
-          (tag (intern (format "eieio-class-tag--%s" cname))))
-      (set tag newc)
-      (fset tag :quick-object-witness-check)
-      (setf (eieio--object-class-tag cache) tag)
+                              nil)))
       (let ((eieio-skip-typecheck t))
 	;; All type-checking has been done to our satisfaction
 	;; before this call.  Don't waste our time in this call..
@@ -1060,9 +1046,9 @@ 'inconsistent-class-hierarchy
   ;; part of the dispatch code.
   50 #'cl--generic-struct-tag
   (lambda (tag &rest _)
-    (and (symbolp tag) (boundp tag) (eieio--class-p (symbol-value tag))
+    (and (eieio--class-p tag)
          (mapcar #'eieio--class-name
-                 (eieio--class-precedence-list (symbol-value tag))))))
+                 (eieio--class-precedence-list tag)))))
 
 (cl-defmethod cl-generic-generalizers :extra "class" (specializer)
   "Support for dispatch on types defined by EIEIO's `defclass'."
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 1a6d5e9..f3530ca 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -701,8 +701,8 @@ 'constructor
 This static method is called when an object is constructed.
 It allocates the vector used to represent an EIEIO object, and then
 calls `initialize-instance' on that object."
-  (let* ((new-object (copy-sequence (eieio--class-default-object-cache
-                                     (eieio--class-object class)))))
+  (let* ((new-object (copy-record (eieio--class-default-object-cache
+                                   (eieio--class-object class)))))
     (if (and slots
              (let ((x (car slots)))
                (or (stringp x) (null x))))
@@ -806,7 +806,7 @@ 'constructor
 
 (cl-defmethod clone ((obj eieio-default-superclass) &rest params)
   "Make a copy of OBJ, and then apply PARAMS."
-  (let ((nobj (copy-sequence obj)))
+  (let ((nobj (copy-record obj)))
     (if (stringp (car params))
         (funcall (if eieio-backward-compatibility #'ignore #'message)
                  "Obsolete name %S passed to clone" (pop params)))
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 289265a..6c4ac51 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -503,24 +503,30 @@ pcase-mutually-exclusive-predicates
     (symbolp . vectorp)
     (symbolp . stringp)
     (symbolp . byte-code-function-p)
+    (symbolp . recordp)
     (integerp . consp)
     (integerp . arrayp)
     (integerp . vectorp)
     (integerp . stringp)
     (integerp . byte-code-function-p)
+    (integerp . recordp)
     (numberp . consp)
     (numberp . arrayp)
     (numberp . vectorp)
     (numberp . stringp)
     (numberp . byte-code-function-p)
+    (numberp . recordp)
     (consp . arrayp)
     (consp . atom)
     (consp . vectorp)
     (consp . stringp)
     (consp . byte-code-function-p)
+    (consp . recordp)
     (arrayp . byte-code-function-p)
     (vectorp . byte-code-function-p)
+    (vectorp . recordp)
     (stringp . vectorp)
+    (stringp . recordp)
     (stringp . byte-code-function-p)))
 
 (defun pcase--mutually-exclusive-p (pred1 pred2)




^ permalink raw reply related	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-18 17:17     ` Lars Brinkhoff
@ 2017-03-18 17:21       ` Lars Brinkhoff
  2017-03-18 17:35         ` Eli Zaretskii
  0 siblings, 1 reply; 31+ messages in thread
From: Lars Brinkhoff @ 2017-03-18 17:21 UTC (permalink / raw)
  To: emacs-devel

Backward compatibility with pre-existing struct instances.

If old-struct-compat is set to `t', `type-of' will make an educated
guess whether a vector is a legacy struct instance.  If so, the
returned type will be the contents of slot 0.

* src/data.c (old_struct_prefix, old_struct_prefix_length): New variables.
(vector_struct_p, type_of_vector): New functions.
(Ftype_of): Call type_of_vector.
(old-struct-compat): New variable.

diff --git a/src/data.c b/src/data.c
index 8e0bccc..5a91d92 100644
--- a/src/data.c
+++ b/src/data.c
@@ -201,6 +201,30 @@ static void swap_in_symval_forwarding (struct Lisp_Symbol *,
   return Qnil;
 }
 
+static const char *old_struct_prefix = "cl-struct-";
+static int old_struct_prefix_length;
+
+static int
+vector_struct_p (Lisp_Object object)
+{
+  if (! old_struct_compat || ASIZE (object) < 1)
+    return false;
+
+  Lisp_Object type = AREF (object, 0);
+  return SYMBOLP (type)
+    && strncmp (SDATA (SYMBOL_NAME (type)),
+		old_struct_prefix,
+		old_struct_prefix_length) == 0;
+}
+
+static Lisp_Object
+type_of_vector (Lisp_Object object)
+{
+  if (vector_struct_p (object))
+    return AREF (object, 0);
+  return Qvector;
+}
+
 DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0,
        doc: /* Return a symbol representing the type of OBJECT.
 The symbol returned names the object's basic type;
@@ -243,7 +267,7 @@ static void swap_in_symval_forwarding (struct Lisp_Symbol *,
     case Lisp_Vectorlike:
       switch (PSEUDOVECTOR_TYPE (XVECTOR (object)))
         {
-        case PVEC_NORMAL_VECTOR: return Qvector;
+        case PVEC_NORMAL_VECTOR: return type_of_vector (object);
         case PVEC_WINDOW_CONFIGURATION: return Qwindow_configuration;
         case PVEC_PROCESS: return Qprocess;
         case PVEC_WINDOW: return Qwindow;
@@ -3873,6 +3897,11 @@ enum bool_vector_op { bool_vector_exclusive_or,
   Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM);
   make_symbol_constant (intern_c_string ("most-negative-fixnum"));
 
+  DEFVAR_BOOL ("old-struct-compat", old_struct_compat,
+	       doc: /* Non-nil means hack for old structs is in effect.  */);
+  old_struct_compat = 0;
+  old_struct_prefix_length = strlen (old_struct_prefix);
+
   DEFSYM (Qwatchers, "watchers");
   DEFSYM (Qmakunbound, "makunbound");
   DEFSYM (Qunlet, "unlet");




^ permalink raw reply related	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-18 17:05 ` Lars Brinkhoff
  2017-03-18 17:13   ` Lars Brinkhoff
@ 2017-03-18 17:29   ` Eli Zaretskii
  1 sibling, 0 replies; 31+ messages in thread
From: Eli Zaretskii @ 2017-03-18 17:29 UTC (permalink / raw)
  To: Lars Brinkhoff; +Cc: emacs-devel

> From: Lars Brinkhoff <lars@nocrew.org>
> Date: Sat, 18 Mar 2017 18:05:50 +0100
> 
> Add record objects with user-defined types.

Thanks.  I hope you will add documentation and some tests at some
future point.

A few minor comments below.

> +static struct Lisp_Vector *
> +allocate_record (int count)
> +{
> +  if (count >= (1 << PSEUDOVECTOR_SIZE_BITS))
> +    error ("Record too large");

I think this error should be signaled by the APIs themselves, and it
should include the max allowed number and the actual requested number.

> +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.  */)

This line is too long, I suggest to describe the arguments on separate
lines.

Also, the doc string should state the maximum allowed value of SLOTS.

> +DEFUN ("record", Frecord, Srecord, 1, MANY, 0,
> +       doc: /* Return a newly created record of type TYPE the rest of the arguments as slots.

This line is too long.  It also doesn't sound right to me: perhaps
"with" is missing?

> +Any number of slots, even zero slots, are allowed.

Which is a lie, since a number that is too large will cause an error
be signaled, right?

> +  memcpy (p->contents + 1, args + 1, (nargs - 1) * sizeof *args);

Should the doc string state that a shallow copy of the arguments is
done?

> +DEFUN ("copy-record", Fcopy_record, Scopy_record, 1, 1, 0,
> +       doc: /* Shallow copy of a record.  */)

I'm not sure this doc string is detailed enough.  How about

  Return a new record that is a shallow copy of the argument RECORD.

?

> +INLINE void
> +CHECK_RECORD_TYPE (Lisp_Object x)
> +{
> +  /* CHECK_SYMBOL (x); */
> +}

???



^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-18 17:21       ` Lars Brinkhoff
@ 2017-03-18 17:35         ` Eli Zaretskii
  2017-03-18 19:33           ` Lars Brinkhoff
  0 siblings, 1 reply; 31+ messages in thread
From: Eli Zaretskii @ 2017-03-18 17:35 UTC (permalink / raw)
  To: Lars Brinkhoff; +Cc: emacs-devel

> From: Lars Brinkhoff <lars@nocrew.org>
> Date: Sat, 18 Mar 2017 18:21:48 +0100
> 
> +static const char *old_struct_prefix = "cl-struct-";
> +static int old_struct_prefix_length;
> +
> +static int
> +vector_struct_p (Lisp_Object object)
> +{
> +  if (! old_struct_compat || ASIZE (object) < 1)
> +    return false;
> +
> +  Lisp_Object type = AREF (object, 0);
> +  return SYMBOLP (type)
> +    && strncmp (SDATA (SYMBOL_NAME (type)),
> +		old_struct_prefix,
> +		old_struct_prefix_length) == 0;

Why not make old_struct_prefix be an array, and then use sizeof
instead of computing the length of the string at dump time?

> +  DEFVAR_BOOL ("old-struct-compat", old_struct_compat,
> +	       doc: /* Non-nil means hack for old structs is in effect.  */);

This doc string should explain more about the effect of this variable.

Thanks.



^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-18 17:35         ` Eli Zaretskii
@ 2017-03-18 19:33           ` Lars Brinkhoff
  2017-03-18 22:24             ` Stefan Monnier
  0 siblings, 1 reply; 31+ messages in thread
From: Lars Brinkhoff @ 2017-03-18 19:33 UTC (permalink / raw)
  To: emacs-devel

Eli Zaretskii wrote:
> I hope you will add documentation and some tests at some future point.

I certainly will.

> A few minor comments below.

Thank you.  I'm adding new commits to adress all your comments.

>> +INLINE void
>> +CHECK_RECORD_TYPE (Lisp_Object x)
>> +{
>> +  /* CHECK_SYMBOL (x); */
>> +}
>
> ???

This is still a work in progress.  I initially added this function to
check everywhere that the first slot is a valid defstruct type name.
But then Stefan Monnier added support for EIEIO instances and made the
first slot be a class object.




^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-18 19:33           ` Lars Brinkhoff
@ 2017-03-18 22:24             ` Stefan Monnier
  2017-03-19  9:17               ` Lars Brinkhoff
  0 siblings, 1 reply; 31+ messages in thread
From: Stefan Monnier @ 2017-03-18 22:24 UTC (permalink / raw)
  To: emacs-devel

>>> +INLINE void
>>> +CHECK_RECORD_TYPE (Lisp_Object x)
>>> +{
>>> +  /* CHECK_SYMBOL (x); */
>>> +}
>> 
>> ???

> This is still a work in progress.  I initially added this function to
> check everywhere that the first slot is a valid defstruct type name.
> But then Stefan Monnier added support for EIEIO instances and made the
> first slot be a class object.

Right.  Currently the TYPE should be either a symbol (i.e. a "type
name"), or a `record` (a "type descriptor" aka "class") whose first
field (i.e. (aref type 1)) is a symbol.

But I'm not even sure we should enforce this in the `record` and
`make-record` primitives.  After all, it's not needed for safety.
And since we allow (aset <obj> 0 <foo>) we can circumvent this
check anyway.


        Stefan


PS: Of the two possible TYPEs, the `symbol' case is the least efficient,
so it'd be good to get rid of it, but the `record` case has an obvious
bootstrap problem if we force the TYPE to be a `record`.




^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-18 22:24             ` Stefan Monnier
@ 2017-03-19  9:17               ` Lars Brinkhoff
  2017-03-19 12:50                 ` Stefan Monnier
  0 siblings, 1 reply; 31+ messages in thread
From: Lars Brinkhoff @ 2017-03-19  9:17 UTC (permalink / raw)
  To: emacs-devel

Stefan Monnier wrote:
>> I initially added this function to check everywhere that the first
>> slot is a valid defstruct type name.  But then Stefan Monnier added
>> support for EIEIO instances and made the first slot be a class
>> object.
>
> But I'm not even sure we should enforce this in the `record` and
> `make-record` primitives.  After all, it's not needed for safety.  And
> since we allow (aset <obj> 0 <foo>) we can circumvent this check
> anyway.

Not quite.  `aset' does the check too.

Also, I thought about disallowing the built-in types.  I imagine some
code would rightly get confused if it saw `integer' for anything else
than integers.  But then, so much else in Emacs depends on people doing
sensible things, so maybe no check is needed at all.

If we come up with a need for a check, we know where to add it.  If not,
I can just delete the unused code.




^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-18 17:04 User-defined record types, v2 Lars Brinkhoff
  2017-03-18 17:05 ` Lars Brinkhoff
@ 2017-03-19 10:28 ` Lars Brinkhoff
  2017-03-19 12:51   ` Stefan Monnier
  2017-03-21  9:55 ` Lars Brinkhoff
  2017-03-22  7:58 ` Lars Brinkhoff
  3 siblings, 1 reply; 31+ messages in thread
From: Lars Brinkhoff @ 2017-03-19 10:28 UTC (permalink / raw)
  To: emacs-devel

There were about 30 unexpected failures in the testsuite due to not
being able to compare records with `equal'.  The fix would either be to
make `equal' compare records just like vectors, or to change all places
using `equal' to something else.

I think the wording of the `equal' docstring and manual makes it ok to
compare records element-wise.  That's also backward compatible.




^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-19  9:17               ` Lars Brinkhoff
@ 2017-03-19 12:50                 ` Stefan Monnier
  2017-03-19 14:51                   ` Eli Zaretskii
  0 siblings, 1 reply; 31+ messages in thread
From: Stefan Monnier @ 2017-03-19 12:50 UTC (permalink / raw)
  To: emacs-devel

>> But I'm not even sure we should enforce this in the `record` and
>> `make-record` primitives.  After all, it's not needed for safety.  And
>> since we allow (aset <obj> 0 <foo>) we can circumvent this check
>> anyway.
> Not quite.  `aset' does the check too.

Hm... so this slows down every use of `aset` on records, 99.99% of which
affect another slot anyway!

> But then, so much else in Emacs depends on people doing sensible
> things, so maybe no check is needed at all.

Exactly.

> If we come up with a need for a check, we know where to add it.  If not,
> I can just delete the unused code.

That'd be my choice.


        Stefan




^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-19 10:28 ` Lars Brinkhoff
@ 2017-03-19 12:51   ` Stefan Monnier
  0 siblings, 0 replies; 31+ messages in thread
From: Stefan Monnier @ 2017-03-19 12:51 UTC (permalink / raw)
  To: emacs-devel

> I think the wording of the `equal' docstring and manual makes it ok to
> compare records element-wise.  That's also backward compatible.

Yes, that's good, thanks.


        Stefan





^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-19 12:50                 ` Stefan Monnier
@ 2017-03-19 14:51                   ` Eli Zaretskii
  0 siblings, 0 replies; 31+ messages in thread
From: Eli Zaretskii @ 2017-03-19 14:51 UTC (permalink / raw)
  To: Stefan Monnier; +Cc: emacs-devel

> From: Stefan Monnier <monnier@iro.umontreal.ca>
> Date: Sun, 19 Mar 2017 08:50:24 -0400
> 
> >> But I'm not even sure we should enforce this in the `record` and
> >> `make-record` primitives.  After all, it's not needed for safety.  And
> >> since we allow (aset <obj> 0 <foo>) we can circumvent this check
> >> anyway.
> > Not quite.  `aset' does the check too.
> 
> Hm... so this slows down every use of `aset` on records, 99.99% of which
> affect another slot anyway!
> 
> > But then, so much else in Emacs depends on people doing sensible
> > things, so maybe no check is needed at all.
> 
> Exactly.
> 
> > If we come up with a need for a check, we know where to add it.  If not,
> > I can just delete the unused code.
> 
> That'd be my choice.

We could instead leave it in an eassert.



^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-18 17:04 User-defined record types, v2 Lars Brinkhoff
  2017-03-18 17:05 ` Lars Brinkhoff
  2017-03-19 10:28 ` Lars Brinkhoff
@ 2017-03-21  9:55 ` Lars Brinkhoff
  2017-03-21 11:53   ` Stefan Monnier
  2017-03-22 21:15   ` Stefan Monnier
  2017-03-22  7:58 ` Lars Brinkhoff
  3 siblings, 2 replies; 31+ messages in thread
From: Lars Brinkhoff @ 2017-03-21  9:55 UTC (permalink / raw)
  To: emacs-devel

There are three remaining failures in the test suite.  I'm looking into
them.

One of them is quite puzzling to me, and may require some EIEIO
insights.  In a fresh Emacs instance, define a class with a class
allocation slot:

    (require 'eieio)
    (defclass foo ()
      ((x :initarg :emu
          :initform emu
          :allocation :class
          :accessor get-foo)))

Now, this will fail:

    (progn (get-foo (foo)) (get-foo 'foo))

However, if you restart Emacs and define the class again, this will
work:

    (progn (get-foo 'foo) (get-foo (foo)))

As far as I can see, in the failing case, (get-foo 'foo) will enter the
method with the foo specializer.  In the other case it correctly enters
the method with the (subclass foo) specializer.




^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-21  9:55 ` Lars Brinkhoff
@ 2017-03-21 11:53   ` Stefan Monnier
  2017-03-22 21:15   ` Stefan Monnier
  1 sibling, 0 replies; 31+ messages in thread
From: Stefan Monnier @ 2017-03-21 11:53 UTC (permalink / raw)
  To: emacs-devel

> insights.  In a fresh Emacs instance, define a class with a class
> allocation slot:
>
>     (require 'eieio)
>     (defclass foo ()
>       ((x :initarg :emu
>           :initform emu
>           :allocation :class
>           :accessor get-foo)))
>
> Now, this will fail:
>
>     (progn (get-foo (foo)) (get-foo 'foo))
>
> However, if you restart Emacs and define the class again, this will
> work:
>
>     (progn (get-foo 'foo) (get-foo (foo)))

I'll take a look at it.


        Stefan




^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-18 17:04 User-defined record types, v2 Lars Brinkhoff
                   ` (2 preceding siblings ...)
  2017-03-21  9:55 ` Lars Brinkhoff
@ 2017-03-22  7:58 ` Lars Brinkhoff
  2017-03-22  8:46   ` Andreas Schwab
  3 siblings, 1 reply; 31+ messages in thread
From: Lars Brinkhoff @ 2017-03-22  7:58 UTC (permalink / raw)
  To: emacs-devel

What should the read/print syntax for records be?  I only used #%[...]
because it's convenient to call read_vector, and records are similar to
byte-code pseudovectors.

How about #<record ...> or #s(record ...)?




^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-22  7:58 ` Lars Brinkhoff
@ 2017-03-22  8:46   ` Andreas Schwab
  0 siblings, 0 replies; 31+ messages in thread
From: Andreas Schwab @ 2017-03-22  8:46 UTC (permalink / raw)
  To: Lars Brinkhoff; +Cc: emacs-devel

On Mär 22 2017, Lars Brinkhoff <lars@nocrew.org> wrote:

> How about #<record ...> or #s(record ...)?

#<...> is generally used for non-readable things.

Andreas.

-- 
Andreas Schwab, SUSE Labs, schwab@suse.de
GPG Key fingerprint = 0196 BAD8 1CE9 1970 F4BE  1748 E4D4 88E3 0EEA B9D7
"And now for something completely different."



^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-21  9:55 ` Lars Brinkhoff
  2017-03-21 11:53   ` Stefan Monnier
@ 2017-03-22 21:15   ` Stefan Monnier
  2017-03-23  6:53     ` Lars Brinkhoff
  1 sibling, 1 reply; 31+ messages in thread
From: Stefan Monnier @ 2017-03-22 21:15 UTC (permalink / raw)
  To: Lars Brinkhoff; +Cc: emacs-devel

> Now, this will fail:
>
>     (progn (get-foo (foo)) (get-foo 'foo))
>
> However, if you restart Emacs and define the class again, this will
> work:
>
>     (progn (get-foo 'foo) (get-foo (foo)))

Hmm... I can't reproduce this right now.  Have you fixed it in the mean time?


        Stefan



^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-22 21:15   ` Stefan Monnier
@ 2017-03-23  6:53     ` Lars Brinkhoff
  2017-03-23  7:02       ` Lars Brinkhoff
  0 siblings, 1 reply; 31+ messages in thread
From: Lars Brinkhoff @ 2017-03-23  6:53 UTC (permalink / raw)
  To: emacs-devel

Stefan Monnier wrote:
>> Now, this will fail:
>>
>>     (progn (get-foo (foo)) (get-foo 'foo))
>>
>> However, if you restart Emacs and define the class again, this will
>> work:
>>
>>     (progn (get-foo 'foo) (get-foo (foo)))
>
> Hmm... I can't reproduce this right now.  Have you fixed it in the
> mean time?

No, I haven't.

Did you make a full rebuild?  I'll usually do a git clean and then a
full bootstrap to be really sure.

It could be that my test case isn't right.  I distilled it from one of
the two testsuite failures.  They both involve using a subclass
specializer in a EIEIO defmethod.

I'm rebuilding and checking again now.




^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-23  6:53     ` Lars Brinkhoff
@ 2017-03-23  7:02       ` Lars Brinkhoff
  2017-03-23  7:34         ` Lars Brinkhoff
  2017-03-23 19:47         ` Stefan Monnier
  0 siblings, 2 replies; 31+ messages in thread
From: Lars Brinkhoff @ 2017-03-23  7:02 UTC (permalink / raw)
  To: emacs-devel

Lars Brinkhoff wrote:
>> Hmm... I can't reproduce this right now.  Have you fixed it in the
>> mean time?
>
> I'm rebuilding and checking again now.

Still same error.

This is exactly how I reproduce it:

git clean -xfd
./autogen.sh
make bootstrap
make check
# 2 files contained unexpected results:
#   lisp/emacs-lisp/eieio-tests/eieio-tests.log
#   lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.log
src/emacs -Q

Evaluate this in *scratch*

(progn
  (require 'eieio)
  (defclass foo ()
    ((x :initarg :emu
         :initform emu
         :allocation :class
         :accessor get-foo)))
  (get-foo (foo))
  (get-foo 'foo))

I get this backtrace:

Debugger entered--Lisp error: (error "eieio-oref called on a class: foo")
  signal(error ("eieio-oref called on a class: foo"))
  error("eieio-oref called on a class: %s" foo)
  eieio-oref(foo x)
  (if (slot-boundp this (quote x)) (eieio-oref this (quote x)))
  (progn (if (slot-boundp this (quote x)) (eieio-oref this (quote x))))
  (lambda (this) "Retrieve the slot `x' from an object of class `foo'."
  (progn (if (slot-boundp this (quote x)) (eieio-oref this (quote x)))))
  (foo)
  apply((lambda (this) "Retrieve the slot `x' from an object of class
  `foo'." (progn (if (slot-boundp this (quote x)) (eieio-oref this
  (quote x))))) foo nil)
  get-foo(foo)
  eval-region(146 305 t #[257 "\300\242b\210\301\207" [(305) (progn
  (require (quote eieio)) (progn (defalias (quote foo-p)
  (eieio-make-class-predicate (quote foo))) (defalias (quote
  foo--eieio-childp) (eieio-make-child-predicate (quote foo))) (defalias
  (quote foo-child-p) (quote foo--eieio-childp)) (make-obsolete (quote
  foo-child-p) "use (cl-typep ... 'foo) instead" "25.1") (put (quote
  foo) (quote cl-deftype-satisfies) (function foo--eieio-childp))
  (eieio-defclass-internal (quote foo) (quote nil) (quote (...)) (quote
  nil)) (progn nil nil (cl-generic-define-method (quote get-foo) (quote
  nil) (quote ...) nil (function ...))) (progn nil nil
  (cl-generic-define-method (quote get-foo) (quote nil) (quote ...) nil
  (function ...))) (progn nil nil (cl-generic-define-method (quote
  \(setf\ get-foo\)) (quote nil) (quote ...) nil (function ...))) (prog1
  (defalias (quote foo) (function ...)) (progn (quote foo--anon-cmacro)
  :autoload-end (quote foo--anon-cmacro)))) (get-foo (foo)) (get-foo
  (quote foo)))] 2 "\n\n(fn IGNORE)"])  ; Reading at buffer position 172
  elisp--eval-defun()
  eval-defun(nil)
  funcall-interactively(eval-defun nil)
  call-interactively(eval-defun nil nil)
  command-execute(eval-defun)




^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-23  7:02       ` Lars Brinkhoff
@ 2017-03-23  7:34         ` Lars Brinkhoff
  2017-03-23 19:47         ` Stefan Monnier
  1 sibling, 0 replies; 31+ messages in thread
From: Lars Brinkhoff @ 2017-03-23  7:34 UTC (permalink / raw)
  To: emacs-devel

Lars Brinkhoff wrote:
> Still same error.
> This is exactly how I reproduce it:

Forgot to say I checked out scratch/record~ from savannah, commit b9bebba.

Those two failures have showed up consistently the last few days, so
it's not a fluke.




^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-23  7:02       ` Lars Brinkhoff
  2017-03-23  7:34         ` Lars Brinkhoff
@ 2017-03-23 19:47         ` Stefan Monnier
  2017-03-24 10:15           ` Lars Brinkhoff
  1 sibling, 1 reply; 31+ messages in thread
From: Stefan Monnier @ 2017-03-23 19:47 UTC (permalink / raw)
  To: emacs-devel

> Still same error.

> This is exactly how I reproduce it:

> git clean -xfd
> ./autogen.sh
> make bootstrap
> make check
> # 2 files contained unexpected results:
> #   lisp/emacs-lisp/eieio-tests/eieio-tests.log
> #   lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.log
> src/emacs -Q

Sorry, pilot error, indeed.

BTW, I see further compatibility problems:

if you compile a chunk of code which constructs structs, they get
macroexpanded/inlined to code that does either

    (record 'FOO <args>)
or
    (vector 'cl-struct-FOO <args>)

depending on whether the corresponding cl-defstruct is using the old or
the new style.

So if this is in a different file from the one that does the
`cl-defstruct` you can end up with a situation where the
`cl-define-struct` defines a new-style struct (because it was recently
recompiled), while some code constructs old style structs of that
same type (because it hasn't been recompiled recently).


        Stefan




^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-23 19:47         ` Stefan Monnier
@ 2017-03-24 10:15           ` Lars Brinkhoff
  2017-03-24 18:17             ` Stefan Monnier
  2017-03-29 12:46             ` Lars Brinkhoff
  0 siblings, 2 replies; 31+ messages in thread
From: Lars Brinkhoff @ 2017-03-24 10:15 UTC (permalink / raw)
  To: emacs-devel

Stefan Monnier wrote:
> BTW, I see further compatibility problems:
>
> if you compile a chunk of code which constructs structs, they get
> macroexpanded/inlined to code that does either
>
>     (record 'FOO <args>)
> or
>     (vector 'cl-struct-FOO <args>)
>
> depending on whether the corresponding cl-defstruct is using the old or
> the new style.
>
> So if this is in a different file from the one that does the
> `cl-defstruct` you can end up with a situation where the
> `cl-define-struct` defines a new-style struct (because it was recently
> recompiled), while some code constructs old style structs of that
> same type (because it hasn't been recompiled recently).

The easy way out would seem to have old-struct-compat set to t by
default.  Then, maybe next major release default to nil.

Or check something in the .elc file when it's loaded.  The Emacs version
number is there (or if it isn't, it's really ancient; looking at you
Emacs 16).  Explicit information about using records could be put in.




^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-24 10:15           ` Lars Brinkhoff
@ 2017-03-24 18:17             ` Stefan Monnier
  2017-03-24 20:38               ` Lars Brinkhoff
  2017-03-29 12:46             ` Lars Brinkhoff
  1 sibling, 1 reply; 31+ messages in thread
From: Stefan Monnier @ 2017-03-24 18:17 UTC (permalink / raw)
  To: emacs-devel

> The easy way out would seem to have old-struct-compat set to t by
> default.  Then, maybe next major release default to nil.

That's one part, but it also means that a new-style FOO-p might need to
accept old-style vector-structs rather than only records.

I tried to fix these issues by relying more on `type-of' which I tried
to make work the same way for old and new structs.

I think I also fixed the remaining test failures, tho I haven't re-run
the whole testsuite, so maybe I introduced further failures again.


        Stefan




^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-24 18:17             ` Stefan Monnier
@ 2017-03-24 20:38               ` Lars Brinkhoff
  0 siblings, 0 replies; 31+ messages in thread
From: Lars Brinkhoff @ 2017-03-24 20:38 UTC (permalink / raw)
  To: emacs-devel

Stefan Monnier wrote:
> I think I also fixed the remaining test failures, tho I haven't re-run
> the whole testsuite, so maybe I introduced further failures again.

You did, but only because the tests for old-struct-mode didn't work any
more.  I removed that variable and associated code, and adapted the
tests to work with cl-old-struct-compat-mode.  Now all of the testsuite
passes.




^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-24 10:15           ` Lars Brinkhoff
  2017-03-24 18:17             ` Stefan Monnier
@ 2017-03-29 12:46             ` Lars Brinkhoff
  2017-03-30 12:59               ` Stefan Monnier
  1 sibling, 1 reply; 31+ messages in thread
From: Lars Brinkhoff @ 2017-03-29 12:46 UTC (permalink / raw)
  To: emacs-devel

Lars Brinkhoff wrote:
> Stefan Monnier wrote:
>> So if this is in a different file from the one that does the
>> `cl-defstruct` you can end up with a situation where the
>> `cl-define-struct` defines a new-style struct (because it was recently
>> recompiled), while some code constructs old style structs of that
>> same type (because it hasn't been recompiled recently).
>
> Or check something in the .elc file when it's loaded.  The Emacs
> version number is there

I'm trying to make progress on this.  If we bump the version of the
generated elc files from 23 to 24, we can check for that.

I pushed a commit to scratch/record which does this.  I'm not at all
sure if this is the right way to do it.  It does seem to work as
intended, and not break anything else.




^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-29 12:46             ` Lars Brinkhoff
@ 2017-03-30 12:59               ` Stefan Monnier
  2017-03-30 14:57                 ` Lars Brinkhoff
  0 siblings, 1 reply; 31+ messages in thread
From: Stefan Monnier @ 2017-03-30 12:59 UTC (permalink / raw)
  To: emacs-devel

>>> So if this is in a different file from the one that does the
>>> `cl-defstruct` you can end up with a situation where the
>>> `cl-define-struct` defines a new-style struct (because it was recently
>>> recompiled), while some code constructs old style structs of that
>>> same type (because it hasn't been recompiled recently).
>> Or check something in the .elc file when it's loaded.  The Emacs
>> version number is there
> I'm trying to make progress on this.  If we bump the version of the
> generated elc files from 23 to 24, we can check for that.

I think it's OK to ask the user to explicitly enable the
compatibility code.  It's also a way to make the user aware of the issue
and motivate him to recompile his files.


        Stefan




^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-30 12:59               ` Stefan Monnier
@ 2017-03-30 14:57                 ` Lars Brinkhoff
  2017-03-30 15:07                   ` Stefan Monnier
  0 siblings, 1 reply; 31+ messages in thread
From: Lars Brinkhoff @ 2017-03-30 14:57 UTC (permalink / raw)
  To: emacs-devel

Stefan Monnier wrote:
>> I'm trying to make progress on this.  If we bump the version of the
>> generated elc files from 23 to 24, we can check for that.
> 
> I think it's OK to ask the user to explicitly enable the compatibility
> code.  It's also a way to make the user aware of the issue and
> motivate him to recompile his files.

Ok, I'll drop that commit then.  But I suppose the check in
cl-struct-define can stay?

Once that is fixed, I believe the branch is ready for merging.  As far
as I know.  Should I wait for a "go" or "no go" decision from someone?




^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-30 14:57                 ` Lars Brinkhoff
@ 2017-03-30 15:07                   ` Stefan Monnier
  2017-03-30 18:10                     ` Eli Zaretskii
  0 siblings, 1 reply; 31+ messages in thread
From: Stefan Monnier @ 2017-03-30 15:07 UTC (permalink / raw)
  To: emacs-devel

>>> I'm trying to make progress on this.  If we bump the version of the
>>> generated elc files from 23 to 24, we can check for that.
>> I think it's OK to ask the user to explicitly enable the compatibility
>> code.  It's also a way to make the user aware of the issue and
>> motivate him to recompile his files.
> Ok, I'll drop that commit then.  But I suppose the check in
> cl-struct-define can stay?

I think so, yes.

> Once that is fixed, I believe the branch is ready for merging.  As far
> as I know.  Should I wait for a "go" or "no go" decision from someone?

Yes: I don't know if Eli and John think this is a good idea.


        Stefan




^ permalink raw reply	[flat|nested] 31+ messages in thread

* Re: User-defined record types, v2
  2017-03-30 15:07                   ` Stefan Monnier
@ 2017-03-30 18:10                     ` Eli Zaretskii
  0 siblings, 0 replies; 31+ messages in thread
From: Eli Zaretskii @ 2017-03-30 18:10 UTC (permalink / raw)
  To: Stefan Monnier; +Cc: emacs-devel

> From: Stefan Monnier <monnier@iro.umontreal.ca>
> Date: Thu, 30 Mar 2017 11:07:20 -0400
> 
> > Once that is fixed, I believe the branch is ready for merging.  As far
> > as I know.  Should I wait for a "go" or "no go" decision from someone?
> 
> Yes: I don't know if Eli and John think this is a good idea.

I'm sorry, but I cannot say anything intelligent about such a
significant change that was discussed only between you two.



^ permalink raw reply	[flat|nested] 31+ messages in thread

end of thread, other threads:[~2017-03-30 18:10 UTC | newest]

Thread overview: 31+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-03-18 17:04 User-defined record types, v2 Lars Brinkhoff
2017-03-18 17:05 ` Lars Brinkhoff
2017-03-18 17:13   ` Lars Brinkhoff
2017-03-18 17:17     ` Lars Brinkhoff
2017-03-18 17:21       ` Lars Brinkhoff
2017-03-18 17:35         ` Eli Zaretskii
2017-03-18 19:33           ` Lars Brinkhoff
2017-03-18 22:24             ` Stefan Monnier
2017-03-19  9:17               ` Lars Brinkhoff
2017-03-19 12:50                 ` Stefan Monnier
2017-03-19 14:51                   ` Eli Zaretskii
2017-03-18 17:29   ` Eli Zaretskii
2017-03-19 10:28 ` Lars Brinkhoff
2017-03-19 12:51   ` Stefan Monnier
2017-03-21  9:55 ` Lars Brinkhoff
2017-03-21 11:53   ` Stefan Monnier
2017-03-22 21:15   ` Stefan Monnier
2017-03-23  6:53     ` Lars Brinkhoff
2017-03-23  7:02       ` Lars Brinkhoff
2017-03-23  7:34         ` Lars Brinkhoff
2017-03-23 19:47         ` Stefan Monnier
2017-03-24 10:15           ` Lars Brinkhoff
2017-03-24 18:17             ` Stefan Monnier
2017-03-24 20:38               ` Lars Brinkhoff
2017-03-29 12:46             ` Lars Brinkhoff
2017-03-30 12:59               ` Stefan Monnier
2017-03-30 14:57                 ` Lars Brinkhoff
2017-03-30 15:07                   ` Stefan Monnier
2017-03-30 18:10                     ` Eli Zaretskii
2017-03-22  7:58 ` Lars Brinkhoff
2017-03-22  8:46   ` Andreas Schwab

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).