From e42b97b0374b71f47d9107cbc1cc855eacb84221 Mon Sep 17 00:00:00 2001 From: Nicolas Petton Date: Fri, 15 May 2015 11:17:50 +0200 Subject: [PATCH] Update seq.el to version 1.7 * packages/seq/seq.el: Update to version 1.7. * packages/seq/tests/seq-tests.el: Update to version 1.7. --- packages/seq/seq.el | 98 ++++++++++++++++++++++++++++++++- packages/seq/tests/seq-tests.el | 21 +++++++ 2 files changed, 117 insertions(+), 2 deletions(-) diff --git a/packages/seq/seq.el b/packages/seq/seq.el index 2f3f519e9..5553de658 100644 --- a/packages/seq/seq.el +++ b/packages/seq/seq.el @@ -4,7 +4,7 @@ ;; Author: Nicolas Petton ;; Keywords: sequences -;; Version: 1.5 +;; Version: 1.7 ;; Package: seq ;; Maintainer: emacs-devel@gnu.org @@ -65,6 +65,39 @@ Evaluate BODY with VAR bound to each element of SEQ, in turn. (pop ,index)))) ,@body))))) +(if (fboundp 'pcase-defmacro) + ;; Implementation of `seq-let' based on a `pcase' + ;; pattern. Requires Emacs>=25.1. + (progn + (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. + +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--make-pcase-patterns args) ,seq)) + ,@body))) + + ;; Implementation of `seq-let' compatible with Emacs<25.1. + (defmacro seq-let (args seq &rest body) + "Bind the variables in ARGS to the elements of SEQ then evaluate BODY. + +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)) + (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. @@ -333,10 +366,70 @@ This is an optimization for lists in `seq-take-while'." (setq n (+ 1 n))) n)) +(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 + (`&rest + (progn (push `(app (pcase--flip seq-drop ,index) + ,(seq--elt-safe args (1+ index))) + bindings) + (setq rest-marker t))) + (t + (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. +(defun seq--make-bindings (args seq &optional bindings) + "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) + (rest-marker nil)) + (seq-doseq (name args) + (unless rest-marker + (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-marker t))) + (t + (push `(,name (seq--elt-safe ,seq ,index)) 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." + (when (or (listp seq) + (and (sequencep seq) + (> (seq-length seq) n))) + (seq-elt seq n))) + (defun seq--activate-font-lock-keywords () "Activate font-lock keywords for some symbols defined in seq." (font-lock-add-keywords 'emacs-lisp-mode - '("\\"))) + '("\\" "\\"))) (defalias 'seq-copy #'copy-sequence) (defalias 'seq-elt #'elt) @@ -344,6 +437,7 @@ This is an optimization for lists in `seq-take-while'." (defalias 'seq-do #'mapc) (defalias 'seq-each #'seq-do) (defalias 'seq-map #'mapcar) +(defalias 'seq-p #'sequencep) (unless (fboundp 'elisp--font-lock-flush-elisp-buffers) ;; In Emacs≥25, (via elisp--font-lock-flush-elisp-buffers and a few others) diff --git a/packages/seq/tests/seq-tests.el b/packages/seq/tests/seq-tests.el index 7f6e06cc4..ab46eb85f 100644 --- a/packages/seq/tests/seq-tests.el +++ b/packages/seq/tests/seq-tests.el @@ -276,5 +276,26 @@ Evaluate BODY for each created sequence. (v2 [2 4 6])) (should (seq-empty-p (seq-difference v1 v2))))) +(ert-deftest test-seq-let () + (with-test-sequences (seq '(1 2 3 4)) + (seq-let (a b c d e) seq + (should (= a 1)) + (should (= b 2)) + (should (= c 3)) + (should (= d 4)) + (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)))) + (let (seq) + (seq-let (a b c) seq + (should (null a)) + (should (null b)) + (should (null c))))) + (provide 'seq-tests) ;;; seq-tests.el ends here -- 2.39.2