From c856843f6b83d4578e7fab3d9821802f2a542540 Mon Sep 17 00:00:00 2001 From: Nicolas Petton Date: Fri, 1 May 2015 19:30:56 +0200 Subject: New macro seq-let, providing destructuring support to seq.el * lisp/emacs-lisp/seq.el (seq-let): New macro. `seq-let' is similar to `cl-destructuring-bind' but works on all sequence types supported by `seq.el'. Bump version number to 1.6. * test/automated/seq-tests.el: Add tests for seq-let. * doc/lispref/sequences.texi: Add documentation for seq-let. --- lisp/emacs-lisp/seq.el | 39 +++++++++++++++++++++++++++++++++++++-- 1 file changed, 37 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 2f3f519e986..d22bbc57817 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -4,7 +4,7 @@ ;; Author: Nicolas Petton ;; Keywords: sequences -;; Version: 1.5 +;; Version: 1.6 ;; Package: seq ;; Maintainer: emacs-devel@gnu.org @@ -40,6 +40,10 @@ ;; ;; All functions are tested in test/automated/seq-tests.el +;;; TODO: + +;; - Add support for &rest in the argument list of seq-let + ;;; Code: (defmacro seq-doseq (spec &rest body) @@ -65,6 +69,14 @@ Evaluate BODY with VAR bound to each element of SEQ, in turn. (pop ,index)))) ,@body))))) +(defmacro seq-let (args seq &rest body) + "Bind the variables in ARGS to the elements of SEQ then evaluate BODY." + (declare (indent 2) (debug t)) + (let ((seq-var (make-symbol "seq"))) + `(let* ((,seq-var ,seq) + ,@(seq--make-bindings args seq-var)) + ,@body))) + (defun seq-drop (seq n) "Return a subsequence of SEQ without its first N elements. The result is a sequence of the same type as SEQ. @@ -336,7 +348,30 @@ This is an optimization for lists in `seq-take-while'." (defun seq--activate-font-lock-keywords () "Activate font-lock keywords for some symbols defined in seq." (font-lock-add-keywords 'emacs-lisp-mode - '("\\"))) + '("\\" "\\"))) + +(defun seq--make-bindings (args seq &optional initial-bindings) + "Return an alist of the bindings the variables in ARGS to the elements of SEQ. +if INITIAL-BINDINGS is non-nil, append new bindings to it, and +return INITIAL-BINDINGS." + (let ((index 0)) + (seq-doseq (name args) + (if (sequencep name) + (setq initial-bindings (seq--make-bindings + (seq--elt-safe args index) + `(seq--elt-safe ,seq ,index) + initial-bindings)) + (push `(,name (seq--elt-safe ,seq ,index)) initial-bindings)) + (setq index (1+ index))) + initial-bindings)) + +(defun seq--elt-safe (seq n) + "Return element of SEQ at the index N. +If no element is found, return nil." + (when (or (listp seq) + (and (sequencep seq) + (> (seq-length seq) n))) + (seq-elt seq n))) (defalias 'seq-copy #'copy-sequence) (defalias 'seq-elt #'elt) -- cgit v1.2.3 From b096be2aa8f2eeaef12cb4e19994f40ab85a342c Mon Sep 17 00:00:00 2001 From: Nicolas Petton Date: Tue, 5 May 2015 20:39:40 +0200 Subject: * lisp/emacs-lisp/seq.el (seq--make-bindings): Improve the docstring. --- lisp/emacs-lisp/seq.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index d22bbc57817..ea7a61382e1 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -351,7 +351,7 @@ This is an optimization for lists in `seq-take-while'." '("\\" "\\"))) (defun seq--make-bindings (args seq &optional initial-bindings) - "Return an alist of the bindings the variables in ARGS to the elements of SEQ. + "Return an alist of bindings of the variables in ARGS to the elements of SEQ. if INITIAL-BINDINGS is non-nil, append new bindings to it, and return INITIAL-BINDINGS." (let ((index 0)) -- cgit v1.2.3 From 6cd74155985f6335e26ffa419c38d0d2f91e3b4e Mon Sep 17 00:00:00 2001 From: Nicolas Petton Date: Tue, 5 May 2015 21:45:36 +0200 Subject: Add support for &rest in `seq-let' * lisp/emacs-lisp/seq.el (seq--make-bindings): Add support for `&rest' in the argument list. * test/automated/seq-tests.el: Add a test for parsing and binding `&rest' in `seq-let'. --- lisp/emacs-lisp/seq.el | 35 ++++++++++++++++++++++------------- test/automated/seq-tests.el | 6 +++++- 2 files changed, 27 insertions(+), 14 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index ea7a61382e1..39389454adf 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -42,7 +42,8 @@ ;;; TODO: -;; - Add support for &rest in the argument list of seq-let +;; - Add a pcase macro named using `pcase-defmacro' that `seq-let' +;; - could wrap. ;;; Code: @@ -350,20 +351,28 @@ This is an optimization for lists in `seq-take-while'." (font-lock-add-keywords 'emacs-lisp-mode '("\\" "\\"))) -(defun seq--make-bindings (args seq &optional initial-bindings) - "Return an alist of bindings of the variables in ARGS to the elements of SEQ. -if INITIAL-BINDINGS is non-nil, append new bindings to it, and -return INITIAL-BINDINGS." - (let ((index 0)) +(defun seq--make-bindings (args seq &optional bindings) + "Return a list of bindings of the variables in ARGS to the elements of SEQ. +if BINDINGS is non-nil, append new bindings to it, and +return BINDINGS." + (let ((index 0) + (rest-bound nil)) (seq-doseq (name args) - (if (sequencep name) - (setq initial-bindings (seq--make-bindings - (seq--elt-safe args index) - `(seq--elt-safe ,seq ,index) - initial-bindings)) - (push `(,name (seq--elt-safe ,seq ,index)) initial-bindings)) + (unless rest-bound + (pcase name + ((pred seq-p) + (setq bindings (seq--make-bindings (seq--elt-safe args index) + `(seq--elt-safe ,seq ,index) + bindings))) + (`&rest + (progn (push `(,(seq--elt-safe args (1+ index)) + (seq-drop ,seq ,index)) + bindings) + (setq rest-bound t))) + (t + (push `(,name (seq--elt-safe ,seq ,index)) bindings)))) (setq index (1+ index))) - initial-bindings)) + bindings)) (defun seq--elt-safe (seq n) "Return element of SEQ at the index N. diff --git a/test/automated/seq-tests.el b/test/automated/seq-tests.el index e1e8ae002d0..ab46eb85f76 100644 --- a/test/automated/seq-tests.el +++ b/test/automated/seq-tests.el @@ -283,7 +283,11 @@ Evaluate BODY for each created sequence. (should (= b 2)) (should (= c 3)) (should (= d 4)) - (should (null e)))) + (should (null e))) + (seq-let (a b &rest others) seq + (should (= a 1)) + (should (= b 2)) + (should (same-contents-p others (seq-drop seq 2))))) (let ((seq '(1 (2 (3 (4)))))) (seq-let (_ (_ (_ (a)))) seq (should (= a 4)))) -- cgit v1.2.3