[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: RFC: User-defined pseudovectors
From: |
Lars Brinkhoff |
Subject: |
Re: RFC: User-defined pseudovectors |
Date: |
Thu, 10 Oct 2013 13:40:44 +0200 |
User-agent: |
Gnus/5.11 (Gnus v5.11) Emacs/22.2 (gnu/linux) |
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
- RFC: User-defined pseudovectors, Lars Brinkhoff, 2013/10/10
- Re: RFC: User-defined pseudovectors, Lars Brinkhoff, 2013/10/10
- Re: RFC: User-defined pseudovectors,
Lars Brinkhoff <=
- Re: RFC: User-defined pseudovectors, Dmitry Antipov, 2013/10/10
- Re: RFC: User-defined pseudovectors, Stefan Monnier, 2013/10/10
- Re: RFC: User-defined pseudovectors, Lars Brinkhoff, 2013/10/10
- Re: RFC: User-defined pseudovectors, Stefan Monnier, 2013/10/10
- Re: RFC: User-defined pseudovectors, Lars Brinkhoff, 2013/10/11
- Re: RFC: User-defined pseudovectors, Stefan Monnier, 2013/10/11
- User-defined record types, Lars Brinkhoff, 2013/10/12
- Re: User-defined record types, Stefan Monnier, 2013/10/15