mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-06 11:55:48 +00:00
Code Issues Releases Activity

* lisp/mh-e/mh-acros.el (mh-defstruct): Minor simplification

Browse Source
This commit is contained in:
Stefan Monnier 2019-02-18 23:11:25 -05:00
parent a755dc13ab
commit 3f6e4c1ce5
1 changed files with 9 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
lisp/mh-e/mh-acros.el
View File

@ -143,6 +143,8 @@ check if variable `transient-mark-mode' is active."
;;;###mh-autoload
(defmacro mh-defstruct (name-spec &rest fields)
;; FIXME: Use `cl-defstruct' instead: shouldn't emit warnings any
;; more nor depend on run-time CL functions.
"Replacement for `defstruct' from the \"cl\" package.
The `defstruct' in the \"cl\" library produces compiler warnings,
and generates code that uses functions present in \"cl\" at
@ -160,15 +162,17 @@ more details."
(constructor (or (and (consp name-spec)
(cadr (assoc :constructor (cdr name-spec))))
(intern (format "make-%s" struct-name))))
(field-names (mapcar #'(lambda (x) (if (atom x) x (car x))) fields))
(field-init-forms (mapcar #'(lambda (x) (and (consp x) (cadr x)))
fields))
(fields (mapcar (lambda (x)
(if (atom x)
(list x nil)
(list (car x) (cadr x))))
fields))
(field-names (mapcar #'car fields))
(struct (gensym "S"))
(x (gensym "X"))
(y (gensym "Y")))
`(progn
(defun* ,constructor (&key ,@(mapcar* #'(lambda (x y) (list x y))
field-names field-init-forms))
(defun* ,constructor (&key ,@fields)
(list (quote ,struct-name) ,@field-names))
(defun ,predicate (arg)
(and (consp arg) (eq (car arg) (quote ,struct-name))))