Re: User-defined record types

[Lars Brinkhoff]

Lars Brinkhoff wrote:
> This is my old patch dusted off and rebased to current master.
> It's just a raw material posted for review.

This is how cl-defstruct could be modified to optionally make record
instances.  More work would probably be needed in cl-preloaded.el and
cl-generic.el.

Test case:

  (cl-defstruct (foo (:type record)) x y z)
  (let ((x (make-foo :y 1)))
    (list (type-of x)
          (foo-p x)
          (recordp x)
          (foo-y x)
          x))



diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 40342f3..dead86e 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2544,6 +2544,12 @@ cl--sublis
       (cons (cl--sublis alist (car tree)) (cl--sublis alist (cdr tree))))
      (t tree))))
 
+(defun record (type &rest elements)
+  (let ((result (make-record type (length elements) nil))
+       (i 0))
+    (dolist (elt elements result)
+      (aset result (cl-incf i) elt))))
+
 ;;; Structures.
 
 (defmacro cl--find-class (type)
@@ -2656,6 +2662,8 @@ cl-defstruct
                                  descs)))
              (t
               (error "Structure option %s unrecognized" opt)))))
+    (if (eq type 'record)
+        (setq named t))
     (unless (or include-name type)
       (setq include-name cl--struct-default-parent))
     (when include-name (setq include (cl--struct-get-class include-name)))
@@ -2684,7 +2692,7 @@ cl-defstruct
          (if (cl--struct-class-named include) (setq tag name named t)))
       (if type
          (progn
-           (or (memq type '(vector list))
+           (or (memq type '(vector list record))
                (error "Invalid :type specifier: %s" type))
            (if named (setq tag name)))
        (setq named 'true)))
@@ -2700,6 +2708,9 @@ cl-defstruct
                              `(and (vectorp cl-x)
                                    (>= (length cl-x) ,(length descs))
                                    (memq (aref cl-x ,pos) ,tag-symbol)))
+                            ((eq type 'record)
+                             `(and (recordp cl-x)
+                                   (memq (type-of cl-x) ,tag-symbol)))
                             ((= pos 0) `(memq (car-safe cl-x) ,tag-symbol))
                             (t `(and (consp cl-x)
                                     (memq (nth ,pos cl-x) ,tag-symbol))))))
@@ -2740,7 +2751,7 @@ cl-defstruct
                              (list `(or ,pred-check
                                          (signal 'wrong-type-argument
                                                  (list ',name cl-x)))))
-                       ,(if (memq type '(nil vector)) `(aref cl-x ,pos)
+                       ,(if (memq type '(nil vector record)) `(aref cl-x ,pos)
                           (if (= pos 0) '(car cl-x)
                             `(nth ,pos cl-x))))
                     forms)