[PATCH] sequence manipulation functions

[Nicolas Petton <petton.nicolas@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 95 bytes --]

Hi,

Here is a patch containing the new version of sequences.el and its
associated test file.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: sequences.diff --]
[-- Type: text/x-patch, Size: 11983 bytes --]

=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog	2014-11-07 10:49:22 +0000
+++ lisp/ChangeLog	2014-11-07 17:23:09 +0000
@@ -1,3 +1,7 @@
+2014-11-07  Nicolas Petton <petton.nicolas@gmail.com>
+
+	* emacs-lisp/sequences.el: New file.
+
 2014-11-07  Martin Rudalics  <rudalics@gmx.at>
 
 	* cus-start.el (frame-resize-pixelwise): Fix group.

=== added file 'lisp/emacs-lisp/sequences.el'
--- lisp/emacs-lisp/sequences.el	1970-01-01 00:00:00 +0000
+++ lisp/emacs-lisp/sequences.el	2014-11-07 17:28:33 +0000
@@ -0,0 +1,137 @@
+;;; sequences.el --- Sequence manipulation functions  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2014 Free Software Foundation, Inc.
+
+;; Author: Nicolas Petton <petton.nicolas@gmail.com>
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Sequence manipulation functions
+
+;;; Code:
+
+(require 'pcase)
+
+(defun seq-drop (n seq)
+  "Return a subsequence, without its first N elements, of the sequence SEQ."
+  (let ((length (seq-length seq)))
+    (seq-subseq seq (min n length) length)))
+
+(defun seq-take (n seq)
+  "Return a sequence of the first N elements of SEQ."
+  (seq-subseq seq 0 (min n (seq-length seq))))
+
+(defun seq-filter (pred seq)
+  "Return a list filtering with PRED all elements of SEQ."
+  (delq nil (mapcar (lambda (elt)
+                      (and (funcall pred elt) elt))
+                    seq)))
+
+(defun seq-reduce (function seq &optional initial-value)
+  "Reduce FUNCTION across SEQ, starting with INITIAL-VALUE if not nil."
+  (or (listp seq) (setq seq (append seq '())))
+  (let ((acc (or initial-value (if (seq-empty-p seq)
+                                   (funcall function)
+                                 (car seq)))))
+    (mapc (lambda (item)
+            (setq acc (funcall function acc item)))
+          (if initial-value seq (cdr seq)))
+    acc))
+
+(defun seq-some-p (pred seq)
+  "Return any element for which PRED is true in SEQ, nil otherwise."
+  (catch 'seq-some-p-break
+    (mapc (lambda (elt)
+            (when (funcall pred elt)
+              (throw 'seq-some-p-break elt)))
+          seq)
+    nil))
+
+(defun seq-every-p (pred seq)
+  "Return t if (PRED item) is non-nil for all elements of the sequence SEQ."
+  (catch 'seq-every-p-break
+    (mapc (lambda (elt)
+            (or (funcall pred elt)
+                (throw 'seq-every-p-break nil)))
+          seq)
+    t))
+
+(defun seq-empty-p (seq)
+  "Return t if the sequence SEQ is empty, nil otherwise."
+  (= 0 (seq-length seq)))
+
+(defun seq-sort (seq pred)
+  "Return a sorted list of the elements of SEQ compared using PRED."
+  (if (listp seq)
+      (sort (seq-copy seq) pred)
+    (seq-sort (append seq nil) pred)))
+
+(defun seq-contains-p (seq elt &optional testfn)
+  "Return the first element in SEQ that equals to ELT.
+Equality is defined by TESTFN if not 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 '()))
+    (mapc (lambda (elt)
+            (unless (seq-contains-p result elt testfn)
+              (setq result (cons elt result))))
+          seq)
+    (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 argument SEQS.
+\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-length #'length)
+
+(provide 'sequences)
+;;; sequences.el ends here

=== modified file 'lisp/loadup.el'
--- lisp/loadup.el	2014-10-15 17:32:41 +0000
+++ lisp/loadup.el	2014-11-07 17:17:48 +0000
@@ -93,6 +93,7 @@
 
 (load "version")
 
+(load "emacs-lisp/sequences")
 (load "widget")
 (load "custom")
 (load "emacs-lisp/map-ynp")

=== modified file 'test/ChangeLog'
--- test/ChangeLog	2014-10-28 20:33:12 +0000
+++ test/ChangeLog	2014-11-07 17:20:11 +0000
@@ -1,3 +1,7 @@
+2014-11-07  Nicolas Petton <petton.nicolas@gmail.com>
+
+	* automated/sequences-tests.el: New file.
+
 2014-10-28  Ulf Jasper  <ulf.jasper@web.de>
 
 	* automated/libxml-tests.el: New file.

=== added file 'test/automated/sequences-tests.el'
--- test/automated/sequences-tests.el	1970-01-01 00:00:00 +0000
+++ test/automated/sequences-tests.el	2014-11-07 17:28:47 +0000
@@ -0,0 +1,153 @@
+;;; sequences-tests.el --- Tests for sequences.el
+
+;; Copyright (C) 2014 Free Software Foundation, Inc.
+
+;; Author: Nicolas Petton <petton.nicolas@gmail.com>
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Tests for sequences.el
+
+;;; Code:
+
+(require 'ert)
+(require 'sequences)
+
+(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 '())))
+
+(ert-deftest test-seq-drop ()
+  (with-test-sequences (seq '(1 2 3 4))
+    (should (equal (seq-drop 0 seq) seq))
+    (should (equal (seq-drop 1 seq) (seq-rest seq)))
+    (should (equal (seq-drop 2 seq) (seq-rest (seq-rest seq))))
+    (should (seq-empty-p (seq-drop 4 seq)))
+    (should (seq-empty-p (seq-drop 10 seq))))
+  (with-test-sequences (seq '())
+    (should (seq-empty-p (seq-drop 0 seq)))
+    (should (seq-empty-p (seq-drop 1 seq)))))
+
+(ert-deftest test-seq-take ()
+  (with-test-sequences (seq '(2 3 4 5))
+    (should (seq-empty-p (seq-take 0 seq)))
+    (should (= (seq-length (seq-take 1 seq)) 1))
+    (should (= (seq-first (seq-take 1 seq)) 2))
+    (should (same-contents-p (seq-take 3 seq) '(2 3 4)))
+    (should (equal (seq-take 10 seq) seq))))
+
+(ert-deftest test-seq-filter ()
+  (with-test-sequences (seq '(6 7 8 9 10))
+    (should (equal (seq-filter #'evenp seq) '(6 8 10)))
+    (should (equal (seq-filter #'oddp seq) '(7 9)))
+    (should (equal (seq-filter (lambda (elt) nil) seq) '())))
+  (with-test-sequences (seq '())
+    (should (equal (seq-filter #'evenp seq) '()))))
+
+(ert-deftest test-seq-reduce ()
+  (with-test-sequences (seq '(1 2 3 4))
+    (should (= (seq-reduce #'+ seq) 10))
+    (should (= (seq-reduce #'+ seq 5) 15)))
+  (with-test-sequences (seq '())
+    (should (eq (seq-reduce #'+ seq) 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 #'evenp seq) 4))
+    (should (= (seq-some-p #'oddp seq) 3))
+    (should-not (seq-some-p (lambda (elt) (> elt 10)) seq)))
+  (with-test-sequences (seq '())
+    (should-not (seq-some-p #'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 #'oddp seq))
+    (should-not (seq-every-p #'evenp seq)))
+  (with-test-sequences (seq '(42 54 22 2))
+    (should (seq-every-p #'evenp seq))
+    (should-not (seq-every-p #'oddp seq)))
+  (with-test-sequences (seq '())
+    (should (seq-every-p #'identity seq))
+    (should (seq-every-p #'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 ()
+  (with-test-sequences (seq '(89 32 12 3 5 1 1))
+    (should (equal (seq-sort seq #'<) '(1 1 3 5 12 32 89))))
+  (with-test-sequences (seq '())
+    (should (equal (seq-sort seq #'<) '()))))
+
+(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 (equal (seq-subseq seq 2 4) (seq-rest (seq-rest seq))))
+    (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 'sequences-tests)
+;;; sequences-tests.el ends here


[-- Attachment #3: Type: text/plain, Size: 1707 bytes --]


- I added the prefix "seq-" to all functions
- I removed "seq-first" and "seq-rest"
- I added "seq-contains-p" and "seq-uniq"
- Both new functions are tested
- I rewrote "seq-some-p"
- "sequences.el" is loaded in "loadup.el"

I'm also willing to document these functions in the Elisp manual.

Regards,
Nico


Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> I understand your point.  Then what do you think about having all other
>> sequence functions prefixed with "seq-"?
>
> Yes, you'll want to add seq-* aliases for things like elt.
>
>> For backward-compatibility, I could keep the current names as aliases,
>> and maybe later obsolete them.
>
> We can start by having seq-elt be an alias for elt (rather than the
> other way around) so as not to need changing anything else.
>
>>> The different of cost between "rest of a list" and "rest of an array" is
>>> so large that merging the two this way is probably not a good idea.
>> Do you mean that the implementation is lacking in some way or that you
>> would remove the "rest" function all together?
>
> I think it's not just an implementation detail but a fundamental
> limitation, so I'd just remove it.  Those who really want it can use
> subseq (or whatever its new name will be, e.g. seq-subseq).
>
> Sebastien Vauban <sva-news@mygooglest.com> writes:
>> Why?  Isn't it still useful for packages in general (and ELPA in
>> particular) so that autoloads files are generated, and these only are
>> what's needed to be loaded... allowing performance gains at startup?
>
> You might as well put a
>
>    ;;;###autoload (require 'seq)
>
> at that point (or add it to loadup.el).
>
>
>         Stefan

-- 
Nicolas Petton
http://nicolas-petton.fr