Re: RFC: User-defined pseudovectors

[Lars Brinkhoff]

Just a small demo of how it would be possible to change cl-defstruct.
With the previous patch applied, plus this one, we get this:

(cl-defstruct foo x y z)

 => foo

(let ((x (make-foo :y 1)))
  (list (type-of x)
        (foo-p x)
        (typed-pseudovector-p x)
        (foo-y x)
        x))

 => (foo t t 1 #%[foo nil 1 nil])


diff a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2312,6 +2312,12 @@ Like `cl-callf', but PLACE is the second argument of 
FUNC, not the first.
 
 ;;; Structures.
 
+(defun typed-pseudovector (type &rest elements)
+  (let ((result (make-typed-pseudovector (length elements) type nil))
+       (i 0))
+    (dolist (elt elements result)
+      (aset result (cl-incf i) elt))))
+
 ;;;###autoload
 (defmacro cl-defstruct (struct &rest descs)
   "Define a struct type.
@@ -2450,21 +2456,25 @@ non-nil value, that slot cannot be set via `setf'.
            (or (memq type '(vector list))
                (error "Invalid :type specifier: %s" type))
            (if named (setq tag name)))
-       (setq type 'vector named 'true)))
+       (setq type 'typed-pseudovector named 'true tag name)))
     (or named (setq descs (delq (assq 'cl-tag-slot descs) descs)))
     (push `(defvar ,tag-symbol) forms)
     (setq pred-form (and named
                         (let ((pos (- (length descs)
                                       (length (memq (assq 'cl-tag-slot descs)
                                                     descs)))))
-                          (if (eq type 'vector)
-                              `(and (vectorp cl-x)
-                                    (>= (length cl-x) ,(length descs))
-                                    (memq (aref cl-x ,pos) ,tag-symbol))
+                          (cond
+                           ((eq type 'vector)
+                            `(and (vectorp cl-x)
+                                  (>= (length cl-x) ,(length descs))
+                                  (memq (aref cl-x ,pos) ,tag-symbol)))
+                           ((eq type 'list)
                             (if (= pos 0)
                                 `(memq (car-safe cl-x) ,tag-symbol)
                               `(and (consp cl-x)
-                                    (memq (nth ,pos cl-x) ,tag-symbol))))))
+                                    (memq (nth ,pos cl-x) ,tag-symbol))))
+                           (t
+                            `(memq (type-of cl-x) ,tag-symbol)))))
          pred-check (and pred-form (> safety 0)
                          (if (and (eq (cl-caadr pred-form) 'vectorp)
                                   (= safety 1))
@@ -2488,9 +2498,10 @@ non-nil value, that slot cannot be set via `setf'.
                              (list `(or ,pred-check
                                          (error "%s accessing a non-%s"
                                                 ',accessor ',name))))
-                       ,(if (eq type 'vector) `(aref cl-x ,pos)
-                          (if (= pos 0) '(car cl-x)
-                            `(nth ,pos cl-x)))) forms)
+                       ,(if (eq type 'list)
+                           (if (= pos 0) '(car cl-x)
+                             `(nth ,pos cl-x))
+                         `(aref cl-x ,pos))) forms)
              (push (cons accessor t) side-eff)
               (if (cadr (memq :read-only (cddr desc)))
                   (push `(gv-define-expander ,accessor