procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge remote-tracking branch 'savannah/master' into HEAD

Browse source
This commit is contained in:
Andrea Corallo 2020-05-09 14:06:55 +01:00
commit c6eb276076
14 changed files with 329 additions and 63 deletions
Download patch file Download diff file Expand all files Collapse all files

15
lisp/emacs-lisp/cl-macs.el
View file

@ -1317,13 +1317,12 @@ For more details, see Info node `(cl)Loop Facility'.
((memq word '(across across-ref))
(let ((temp-vec (make-symbol "--cl-vec--"))
(temp-len (make-symbol "--cl-len--"))
(temp-idx (make-symbol "--cl-idx--")))
(push (list temp-vec (pop cl--loop-args)) loop-for-bindings)
(push (list temp-len `(length ,temp-vec)) loop-for-bindings)
(push (list temp-idx -1) loop-for-bindings)
(push `(setq ,temp-idx (1+ ,temp-idx)) cl--loop-body)
(cl--push-clause-loop-body
`(< (setq ,temp-idx (1+ ,temp-idx)) ,temp-len))
`(< ,temp-idx (length ,temp-vec)))
(if (eq word 'across-ref)
(push (list var `(aref ,temp-vec ,temp-idx))
cl--loop-symbol-macs)
@ -1337,7 +1336,6 @@ For more details, see Info node `(cl)Loop Facility'.
(error "Expected `of'"))))
(seq (cl--pop2 cl--loop-args))
(temp-seq (make-symbol "--cl-seq--"))
(temp-len (make-symbol "--cl-len--"))
(temp-idx
(if (eq (car cl--loop-args) 'using)
(if (and (= (length (cadr cl--loop-args)) 2)
@ -1348,19 +1346,16 @@ For more details, see Info node `(cl)Loop Facility'.
(push (list temp-seq seq) loop-for-bindings)
(push (list temp-idx 0) loop-for-bindings)
(if ref
(progn
(let ((temp-len (make-symbol "--cl-len--")))
(push (list temp-len `(length ,temp-seq))
loop-for-bindings)
(push (list var `(elt ,temp-seq ,temp-idx))
cl--loop-symbol-macs)
(cl--push-clause-loop-body `(< ,temp-idx ,temp-len)))
;; Evaluate seq length just if needed, that is, when seq is not a cons.
(push (list temp-len (or (consp seq) `(length ,temp-seq)))
loop-for-bindings)
(cl--push-clause-loop-body `(< ,temp-idx ,temp-len)))
(push (list var nil) loop-for-bindings)
(cl--push-clause-loop-body `(and ,temp-seq
(or (consp ,temp-seq)
(< ,temp-idx ,temp-len))))
(< ,temp-idx (length ,temp-seq)))))
(push (list var `(if (consp ,temp-seq)
(pop ,temp-seq)
(aref ,temp-seq ,temp-idx)))

17
lisp/emacs-lisp/eieio.el
View file

@ -359,16 +359,13 @@ contents of field NAME is matched against PAT, or they can be of
;; FIXME: `pcase' does not do a good job here of sharing tests&code among
;; various branches.
`(and (pred eieio-object-p)
(app eieio-pcase-slot-index-table ,is)
,@(mapcar (lambda (field)
(let* ((name (if (consp field) (car field) field))
(pat (if (consp field) (cadr field) field))
(i (make-symbol "index")))
`(and (let (and ,i (pred natnump))
(eieio-pcase-slot-index-from-index-table
,is ',name))
(app (pcase--flip aref ,i) ,pat))))
fields))))
,@(mapcar (lambda (field)
(pcase-exhaustive field
(`(,name ,pat)
`(app (pcase--flip eieio-oref ',name) ,pat))
((pred symbolp)
`(app (pcase--flip eieio-oref ',field) ,field))))
fields))))
;;; Simple generators, and query functions. None of these would do
;; well embedded into an object.