Re: RFC: User-defined pseudovectors

[Lars Brinkhoff <lars@nocrew.org>]

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