diff options
author | Nicolas Petton <nicolas@petton.fr> | 2015-05-12 21:57:18 +0200 |
---|---|---|
committer | Nicolas Petton <nicolas@petton.fr> | 2015-05-12 22:15:45 +0200 |
commit | f9ba8dc074bf34d2b3d88df69ed19e9141368b81 (patch) | |
tree | 2f5edb91806a8b66239b8a019784777d93dd7b45 /lisp/emacs-lisp/seq.el | |
parent | 4f5382c6e43cb67e0da7765056866745a2295698 (diff) | |
download | emacs-f9ba8dc074bf34d2b3d88df69ed19e9141368b81.tar.gz |
Improve the seq pcase pattern and the `seq-let' macro
* lisp/emacs-lisp/seq.el: The pcase pattern now matches only if the
object is a sequence, and binds each element of ARGS to the
corresponding element of the sequence.
Diffstat (limited to 'lisp/emacs-lisp/seq.el')
-rw-r--r-- | lisp/emacs-lisp/seq.el | 55 |
1 files changed, 23 insertions, 32 deletions
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index eef96e320a4..5553de658b2 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -69,8 +69,13 @@ Evaluate BODY with VAR bound to each element of SEQ, in turn. ;; Implementation of `seq-let' based on a `pcase' ;; pattern. Requires Emacs>=25.1. (progn - (pcase-defmacro seq (bindings) - `(and ,@(seq--make-pcase-bindings bindings))) + (pcase-defmacro seq (&rest args) + "pcase pattern matching sequence elements. +Matches if the object is a sequence (list, string or vector), and +binds each element of ARGS to the corresponding element of the +sequence." + `(and (pred seq-p) + ,@(seq--make-pcase-bindings args))) (defmacro seq-let (args seq &rest body) "Bind the variables in ARGS to the elements of SEQ then evaluate BODY. @@ -78,7 +83,8 @@ Evaluate BODY with VAR bound to each element of SEQ, in turn. ARGS can also include the `&rest' marker followed by a variable name to be bound to the rest of SEQ." (declare (indent 2) (debug t)) - `(pcase-let (((seq ,args) ,seq)) ,@body))) + `(pcase-let ((,(seq--make-pcase-patterns args) ,seq)) + ,@body))) ;; Implementation of `seq-let' compatible with Emacs<25.1. (defmacro seq-let (args seq &rest body) @@ -360,32 +366,32 @@ This is an optimization for lists in `seq-take-while'." (setq n (+ 1 n))) n)) -(defun seq--make-pcase-bindings (args &optional bindings nested-indexes) - "Return a list of bindings of the variables in ARGS to the elements of a sequence. -if BINDINGS is non-nil, append new bindings to it, and return -BINDINGS." - (let ((index 0) +(defun seq--make-pcase-bindings (args) + "Return a list of bindings of the variables in ARGS to the elements of a sequence." + (let ((bindings '()) + (index 0) (rest-marker nil)) (seq-doseq (name args) (unless rest-marker (pcase name - ((pred seq-p) - (setq bindings (seq--make-pcase-bindings (seq--elt-safe args index) - bindings - (cons index nested-indexes)))) (`&rest - (progn (push `(app (seq--reverse-args #'seq-drop ,index) + (progn (push `(app (pcase--flip seq-drop ,index) ,(seq--elt-safe args (1+ index))) bindings) (setq rest-marker t))) (t - (push `(app (seq--reverse-args #'seq--nested-elt - (reverse (cons ,index ',nested-indexes))) - ,name) - bindings)))) + (push `(app (pcase--flip seq--elt-safe ,index) ,name) bindings)))) (setq index (1+ index))) bindings)) +(defun seq--make-pcase-patterns (args) + "Return a list of `(seq ...)' pcase patterns from the argument list ARGS." + (cons 'seq + (seq-map (lambda (elt) + (if (seq-p elt) + (seq--make-pcase-patterns elt) + elt)) + args))) ;; Helper function for the Backward-compatible version of `seq-let' ;; for Emacs<25.1. @@ -412,7 +418,6 @@ BINDINGS." (setq index (1+ index))) bindings)) - (defun seq--elt-safe (seq n) "Return element of SEQ at the index N. If no element is found, return nil." @@ -421,20 +426,6 @@ If no element is found, return nil." (> (seq-length seq) n))) (seq-elt seq n))) -(defun seq--nested-elt (seq indexes &optional default) - "Traverse SEQ using INDEXES and return the looked up element or DEFAULT if nil. -SEQ can be a nested sequence composed of lists, vectors and strings." - (or (seq-reduce (lambda (acc index) - (when (seq-p acc) - (seq--elt-safe acc index))) - indexes - seq) - default)) - -(defun seq--reverse-args (fn &rest args) - "Call FN with ARGS reversed." - (apply fn (reverse args))) - (defun seq--activate-font-lock-keywords () "Activate font-lock keywords for some symbols defined in seq." (font-lock-add-keywords 'emacs-lisp-mode |