From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Nicolas Petton Newsgroups: gmane.emacs.devel Subject: Re: [PATCH] sequence manipulation functions Date: Mon, 24 Nov 2014 18:49:17 +0100 Message-ID: <871tosh4ki.fsf@gmail.com> References: <87oasmmwzt.fsf@gmail.com> <87bnolslph.fsf@gmail.com> <87zjc2dic0.fsf@gmail.com> <87ioimtzu0.fsf@gmail.com> <87lhngcnrc.fsf@gmail.com> <87k330cj3u.fsf@gmail.com> <87ioikcf39.fsf@gmail.com> <87h9y4c93e.fsf@gmail.com> <87y4r4wwtx.fsf@gmail.com> <87sihcwum5.fsf@gmail.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1416851432 22412 80.91.229.3 (24 Nov 2014 17:50:32 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Mon, 24 Nov 2014 17:50:32 +0000 (UTC) Cc: Bozhidar Batsov , Emacs developers To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Nov 24 18:50:27 2014 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1XsxmN-0003YS-5R for ged-emacs-devel@m.gmane.org; Mon, 24 Nov 2014 18:50:27 +0100 Original-Received: from localhost ([::1]:53847 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XsxmM-0002Cu-R4 for ged-emacs-devel@m.gmane.org; Mon, 24 Nov 2014 12:50:26 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:45522) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XsxlO-0000lw-2B for emacs-devel@gnu.org; Mon, 24 Nov 2014 12:49:30 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1XsxlJ-00018f-F7 for emacs-devel@gnu.org; Mon, 24 Nov 2014 12:49:26 -0500 Original-Received: from mail-lb0-x231.google.com ([2a00:1450:4010:c04::231]:35060) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XsxlI-00018K-TT for emacs-devel@gnu.org; Mon, 24 Nov 2014 12:49:21 -0500 Original-Received: by mail-lb0-f177.google.com with SMTP id 10so4996469lbg.36 for ; Mon, 24 Nov 2014 09:49:19 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=references:user-agent:from:to:cc:subject:in-reply-to:date :message-id:mime-version:content-type; bh=jQHBtDs+vIiVc7bFCSFrAG2KlKlky0PetVz09tscKic=; b=UcAq/t9KPxo1FpS1OsbCzucbmPVtkquEIhp+DbLVMrAi0ZqLasRvzBg6/pBgBk5Og9 //psrVii4gmalGelHCvDOXxTtFJY/z7S/ZnMFdUnPkeydYo96kzqxqyU+jBEn/onxKKN jIJN/Ycm0YdBqdU8tPGdtZZpzJN5dkC1vpFoThBFbBzo20JrYgSNHMnGk/JKWcKLS0ek slCR6/Njqqaa/EmoclZJv2mA7UaXN4bTPpPrbzpx8ZnVoVUWrc8t59G/FO9T5b61cG/z fl2TciuJsIns33xw2d0QGxuDowBodP9XCk/keAKHuaqGklknlfE0hSoNdYGLT7jl817b c+WA== X-Received: by 10.152.88.44 with SMTP id bd12mr6587509lab.88.1416851359245; Mon, 24 Nov 2014 09:49:19 -0800 (PST) Original-Received: from blueberry (31-211-216-84.customers.ownit.se. [31.211.216.84]) by mx.google.com with ESMTPSA id a4sm3693973laa.41.2014.11.24.09.49.17 for (version=TLSv1.2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); Mon, 24 Nov 2014 09:49:18 -0800 (PST) User-agent: mu4e 0.9.9.6pre3; emacs 24.3.1 In-reply-to: X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-Received-From: 2a00:1450:4010:c04::231 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:178190 Archived-At: --=-=-= Content-Type: text/plain Hi, Here's a new version of the patch. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=seq.diff diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 35141b6..b77dd06 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2014-11-24 Nicolas Petton + + * emacs-lisp/seq.el: New file. + 2014-11-24 Stefan Monnier * vc/vc-hooks.el (vc-state-base-face): Don't override diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el new file mode 100644 index 0000000..fa3ad56 --- /dev/null +++ b/lisp/emacs-lisp/seq.el @@ -0,0 +1,222 @@ +;;; seq.el --- Sequence manipulation functions -*- lexical-binding: t -*- + +;; Copyright (C) 2014 Free Software Foundation, Inc. + +;; Author: Nicolas Petton +;; Keywords: sequences + +;; Maintainer: emacs-devel@gnu.org + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Sequence-manipulation functions that complement basic functions +;; provided by subr.el. +;; +;; All functions are prefixed with "seq-". +;; +;; All provided functions work on lists, strings and vectors. +;; +;; Functions taking a predicate or a function iterating over the +;; sequence as argument take the function as their first argument and +;; the sequence as their second argument. All other functions take +;; the sequence as their first argument. +;; +;; All functions are tested in test/automated/seq-tests.el + +;;; Code: + +(defmacro seq-doseq (spec &rest body) + "Loop over a sequence. +Similar to `dolist' but can be applied lists, strings and vectors. + +Evaluate BODY with VAR bound to each element of SEQ, in turn. +Then evaluate RESULT to get return value, default nil. + +\(fn (VAR SEQ [RESULT]) BODY...)" + (declare (indent 1) (debug ((symbolp form &optional form) body))) + (let ((is-list (make-symbol "is-list")) + (seq (make-symbol "seq")) + (index (make-symbol "index"))) + `(let* ((,seq ,(cadr spec)) + (,is-list (listp seq)) + (,index (if ,is-list ,seq 0))) + (while (if ,is-list + (consp ,index) + (< ,index (seq-length ,seq))) + (let ((,(car spec) (if ,is-list + (car ,index) + (seq-elt ,seq ,index)))) + ,@body + (setq ,index (if ,is-list + (cdr ,index) + (+ ,index 1))))) + ,@(if (cddr spec) + `((setq ,(car spec) nil) ,@(cddr spec)))))) + +(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." + (let ((length (seq-length seq))) + (seq-subseq seq (min n length) length))) + +(defun seq-take (seq n) + "Return a subsequence of SEQ with its first N elements. +The result is a sequence of the same type as SEQ." + (seq-subseq seq 0 (min n (seq-length seq)))) + +(defun seq-drop-while (pred seq) + "Return a sequence, from the first element for which (PRED element) is nil, of SEQ. +The result is a sequence of the same type as SEQ." + (let ((n 0)) + (while (and (< n (seq-length seq)) + (funcall pred (seq-elt seq n))) + (setq n (+ 1 n))) + (seq-drop seq n))) + +(defun seq-take-while (pred seq) + "Return a sequence of the successive elements for which (PRED element) is non-nil in SEQ. +The result is a sequence of the same type as SEQ." + (let ((n 0)) + (while (and (< n (seq-length seq)) + (funcall pred (seq-elt seq n))) + (setq n (+ 1 n))) + (seq-take seq n))) + +(defun seq-filter (pred seq) + "Return a list of all the elements for which (PRED element) is non-nil in SEQ." + (let ((exclude (make-symbol "exclude"))) + (delq exclude (seq-map (lambda (elt) + (if (funcall pred elt) + elt + exclude)) + seq)))) + +(defun seq-remove (pred seq) + "Return a list of all the elements for which (PRED element) is nil in SEQ." + (seq-filter (lambda (elt) (not (funcall pred elt))) + seq)) + +(defun seq-reduce (function seq initial-value) + "Reduce the function FUNCTION across SEQ, starting with INITIAL-VALUE. + +Return the result of applying FUNCTION to INITIAL-VALUE and the +first element of SEQ, then applying FUNCTION to that result and +the second element of SEQ, then to that result and the third +element of SEQ, etc. + +If SEQ is empty, return INITIAL-VALUE and FUNCTION is not called." + (if (seq-empty-p seq) + initial-value + (let ((acc initial-value)) + (seq-doseq (elt seq) + (setq acc (funcall function acc elt))) + acc))) + +(defun seq-some-p (pred seq) + "Return any element for which (PRED element) is non-nil in SEQ, nil otherwise." + (catch 'seq--break + (seq-doseq (elt seq) + (when (funcall pred elt) + (throw 'seq--break elt))) + nil)) + +(defun seq-every-p (pred seq) + "Return non-nil if (PRED element) is non-nil for all elements of the sequence SEQ." + (catch 'seq--break + (seq-doseq (elt seq) + (or (funcall pred elt) + (throw 'seq--break nil))) + t)) + +(defun seq-count (pred seq) + "Return the number of elements for which (PRED element) in non-nil in seq." + (let ((count 0)) + (seq-doseq (elt seq) + (when (funcall pred elt) + (setq count (+ 1 count)))) + count)) + +(defun seq-empty-p (seq) + "Return non-nil if the sequence SEQ is empty, nil otherwise." + (= 0 (seq-length seq))) + +(defun seq-sort (pred seq) + "Return a sorted sequence comparing using PRED the elements of SEQ. +The result is a sequence of the same type as SEQ." + (if (listp seq) + (sort (seq-copy seq) pred) + (let ((result (seq-sort pred (append seq nil)))) + (cond ((stringp seq) (concat result)) + ((vectorp seq) (vconcat result)) + (t (error "Unsupported sequence: %s" seq)))))) + +(defun seq-contains-p (seq elt &optional testfn) + "Return the first element in SEQ that equals to ELT. +Equality is defined by TESTFN if non-nil or by `equal' if nil." + (seq-some-p (lambda (e) + (funcall (or testfn #'equal) elt e)) + seq)) + +(defun seq-uniq (seq &optional testfn) + "Return a list of the elements of SEQ with duplicates removed. +Use TESTFN to compare elements, or `equal' if TESTFN is nil." + (let ((result '())) + (seq-doseq (elt seq) + (unless (seq-contains-p result elt testfn) + (setq result (cons elt result)))) + (nreverse result))) + +(defun seq-subseq (seq start &optional end) + "Return the subsequence of SEQ from START to END. +If END is omitted, it defaults to the length of the sequence. +If START or END is negative, it counts from the end." + (cond ((or (stringp seq) (vectorp seq)) (substring seq start end)) + ((listp seq) + (let (len) + (and end (< end 0) (setq end (+ end (setq len (seq-length seq))))) + (if (< start 0) (setq start (+ start (or len (setq len (seq-length seq)))))) + (if (> start 0) (setq seq (nthcdr start seq))) + (if end + (let ((res nil)) + (while (>= (setq end (1- end)) start) + (push (pop seq) res)) + (nreverse res)) + (seq-copy seq)))) + (t (error "Unsupported sequence: %s" seq)))) + +(defun seq-concatenate (type &rest seqs) + "Concatenate, into a sequence of type TYPE, the sequences SEQS. +TYPE must be one of following symbols: vector, string or list. + +\n(fn TYPE SEQUENCE...)" + (pcase type + (`vector (apply #'vconcat seqs)) + (`string (apply #'concat seqs)) + (`list (apply #'append (append seqs '(nil)))) + (t (error "Not a sequence type name: %s" type)))) + +(defalias 'seq-copy #'copy-sequence) +(defalias 'seq-elt #'elt) +(defalias 'seq-reverse #'reverse) +(defalias 'seq-length #'length) +(defalias 'seq-do #'mapc) +(defalias 'seq-each #'seq-do) +(defalias 'seq-map #'mapcar) + +(provide 'seq) +;;; seq.el ends here diff --git a/test/ChangeLog b/test/ChangeLog index d0988e4..776963a 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,7 @@ +2014-11-24 Nicolas Petton + + * automated/seq-tests.el: New file. + 2014-11-21 Ulf Jasper * automated/libxml-tests.el diff --git a/test/automated/seq-tests.el b/test/automated/seq-tests.el new file mode 100644 index 0000000..31a05ac --- /dev/null +++ b/test/automated/seq-tests.el @@ -0,0 +1,177 @@ +;;; seq-tests.el --- Tests for sequences.el + +;; Copyright (C) 2014 Free Software Foundation, Inc. + +;; Author: Nicolas Petton +;; Maintainer: emacs-devel@gnu.org + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Tests for sequences.el + +;;; Code: + +(require 'ert) +(require 'seq) + +(defmacro with-test-sequences (spec &rest body) + "Successively bind VAR to a list, vector, and string built from SEQ. +Evaluate BODY for each created sequence. + +\(fn (var seq) body)" + (declare (indent 1) (debug ((symbolp form) body))) + (let ((initial-seq (make-symbol "initial-seq"))) + `(let ((,initial-seq ,(cadr spec))) + ,@(mapcar (lambda (s) + `(let ((,(car spec) (apply (function ,s) ,initial-seq))) + ,@body)) + '(list vector string))))) + +(defun same-contents-p (seq1 seq2) + "Return t if SEQ1 and SEQ2 have the same contents, nil otherwise." + (equal (append seq1 '()) (append seq2 '()))) + +(defun test-sequences-evenp (integer) + "Return t if INTEGER is even." + (eq (logand integer 1) 0)) + +(defun test-sequences-oddp (integer) + "Return t if INTEGER is odd." + (not (test-sequences-evenp integer))) + +(ert-deftest test-seq-drop () + (with-test-sequences (seq '(1 2 3 4)) + (should (equal (seq-drop seq 0) seq)) + (should (equal (seq-drop seq 1) (seq-subseq seq 1))) + (should (equal (seq-drop seq 2) (seq-subseq seq 2))) + (should (seq-empty-p (seq-drop seq 4))) + (should (seq-empty-p (seq-drop seq 10)))) + (with-test-sequences (seq '()) + (should (seq-empty-p (seq-drop seq 0))) + (should (seq-empty-p (seq-drop seq 1))))) + +(ert-deftest test-seq-take () + (with-test-sequences (seq '(2 3 4 5)) + (should (seq-empty-p (seq-take seq 0))) + (should (= (seq-length (seq-take seq 1)) 1)) + (should (= (seq-elt (seq-take seq 1) 0) 2)) + (should (same-contents-p (seq-take seq 3) '(2 3 4))) + (should (equal (seq-take seq 10) seq)))) + +(ert-deftest test-seq-filter () + (with-test-sequences (seq '(6 7 8 9 10)) + (should (equal (seq-filter #'test-sequences-evenp seq) '(6 8 10))) + (should (equal (seq-filter #'test-sequences-oddp seq) '(7 9))) + (should (equal (seq-filter (lambda (elt) nil) seq) '()))) + (with-test-sequences (seq '()) + (should (equal (seq-filter #'test-sequences-evenp seq) '())))) + +(ert-deftest test-seq-remove () + (with-test-sequences (seq '(6 7 8 9 10)) + (should (equal (seq-remove #'test-sequences-evenp seq) '(7 9))) + (should (equal (seq-remove #'test-sequences-oddp seq) '(6 8 10))) + (should (same-contents-p (seq-remove (lambda (elt) nil) seq) seq))) + (with-test-sequences (seq '()) + (should (equal (seq-remove #'test-sequences-evenp seq) '())))) + +(ert-deftest test-seq-count () + (with-test-sequences (seq '(6 7 8 9 10)) + (should (equal (seq-count #'test-sequences-evenp seq) 3)) + (should (equal (seq-count #'test-sequences-oddp seq) 2)) + (should (equal (seq-count (lambda (elt) nil) seq) 0))) + (with-test-sequences (seq '()) + (should (equal (seq-count #'test-sequences-evenp seq) 0)))) + +(ert-deftest test-seq-reduce () + (with-test-sequences (seq '(1 2 3 4)) + (should (= (seq-reduce #'+ seq 0) 10)) + (should (= (seq-reduce #'+ seq 5) 15))) + (with-test-sequences (seq '()) + (should (eq (seq-reduce #'+ seq 0) 0)) + (should (eq (seq-reduce #'+ seq 7) 7)))) + +(ert-deftest test-seq-some-p () + (with-test-sequences (seq '(4 3 2 1)) + (should (= (seq-some-p #'test-sequences-evenp seq) 4)) + (should (= (seq-some-p #'test-sequences-oddp seq) 3)) + (should-not (seq-some-p (lambda (elt) (> elt 10)) seq))) + (with-test-sequences (seq '()) + (should-not (seq-some-p #'test-sequences-oddp seq)))) + +(ert-deftest test-seq-contains-p () + (with-test-sequences (seq '(3 4 5 6)) + (should (seq-contains-p seq 3)) + (should-not (seq-contains-p seq 7))) + (with-test-sequences (seq '()) + (should-not (seq-contains-p seq 3)) + (should-not (seq-contains-p seq nil)))) + +(ert-deftest test-seq-every-p () + (with-test-sequences (seq '(43 54 22 1)) + (should (seq-every-p (lambda (elt) t) seq)) + (should-not (seq-every-p #'test-sequences-oddp seq)) + (should-not (seq-every-p #'test-sequences-evenp seq))) + (with-test-sequences (seq '(42 54 22 2)) + (should (seq-every-p #'test-sequences-evenp seq)) + (should-not (seq-every-p #'test-sequences-oddp seq))) + (with-test-sequences (seq '()) + (should (seq-every-p #'identity seq)) + (should (seq-every-p #'test-sequences-evenp seq)))) + +(ert-deftest test-seq-empty-p () + (with-test-sequences (seq '(0)) + (should-not (seq-empty-p seq))) + (with-test-sequences (seq '(0 1 2)) + (should-not (seq-empty-p seq))) + (with-test-sequences (seq '()) + (should (seq-empty-p seq)))) + +(ert-deftest test-seq-sort () + (should (equal (seq-sort #'< "cbaf") "abcf")) + (should (equal (seq-sort #'< '(2 1 9 4)) '(1 2 4 9))) + (should (equal (seq-sort #'< [2 1 9 4]) [1 2 4 9])) + (should (equal (seq-sort #'< "") ""))) + +(ert-deftest test-seq-uniq () + (with-test-sequences (seq '(2 4 6 8 6 4 3)) + (should (equal (seq-uniq seq) '(2 4 6 8 3)))) + (with-test-sequences (seq '(3 3 3 3 3)) + (should (equal (seq-uniq seq) '(3)))) + (with-test-sequences (seq '()) + (should (equal (seq-uniq seq) '())))) + +(ert-deftest test-seq-subseq () + (with-test-sequences (seq '(2 3 4 5)) + (should (equal (seq-subseq seq 0 4) seq)) + (should (same-contents-p (seq-subseq seq 2 4) '(4 5))) + (should (same-contents-p (seq-subseq seq 1 3) '(3 4))) + (should (same-contents-p (seq-subseq seq 1 -1) '(3 4)))) + (should (vectorp (seq-subseq [2 3 4 5] 2))) + (should (stringp (seq-subseq "foo" 2 3))) + (should (listp (seq-subseq '(2 3 4 4) 2 3)))) + +(ert-deftest test-seq-concatenate () + (with-test-sequences (seq '(2 4 6)) + (should (equal (seq-concatenate 'string seq [8]) (string 2 4 6 8))) + (should (equal (seq-concatenate 'list seq '(8 10)) '(2 4 6 8 10))) + (should (equal (seq-concatenate 'vector seq '(8 10)) [2 4 6 8 10])) + (should (equal (seq-concatenate 'vector nil '(8 10)) [8 10])) + (should (equal (seq-concatenate 'vector seq nil) [2 4 6])))) + +(provide 'seq-tests) +;;; seq-tests.el ends here --=-=-= Content-Type: text/plain I fixed all the byte-compile warnings, added an alias for `reverse', and improved `seq-doseq'. Stefan, can you have another look at seq-doseq? Cheers, Nico Stefan Monnier writes: >>>> The macro could use to "dolist" if the sequence is a list. >>> But you'd then duplicate the code of the body, which could be >>> problematic, especially with nested seq-doseq loops. >> Oh, right! Another way would be to use a function, but I tried to avoid >> that. Do you have a better idea in mind? > > You can change your `i' to be either an integer (for arrays) or a cons > cell (for lists). That requires an extra "is it a list?" test at each > iteration of the loop (to know how to extract the element and to > "increment" i), but I think it's the best we can do. > > > Stefan -- Nicolas Petton http://nicolas-petton.fr --=-=-=--