unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* sequence manipulation functions
@ 2014-11-04 22:17 Nicolas Petton
  2014-11-05  1:21 ` Glenn Morris
                   ` (3 more replies)
  0 siblings, 4 replies; 56+ messages in thread
From: Nicolas Petton @ 2014-11-04 22:17 UTC (permalink / raw)
  To: Emacs developers

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

Hi!

Here are two files that add some missing sequence-manipulation functions
to Emacs Lisp.


[-- Attachment #2: sequences.el --]
[-- Type: text/plain, Size: 4277 bytes --]

;;; 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:

;;;###autoload
(defun first (seq)
  "Return the first element of the sequence SEQ.
If SEQ is nil or empty, return nil."
  (if (listp seq)
      (car seq)
    (when (not (empty-p seq))
      (elt seq 0))))

;;;###autoload
(defun rest (seq)
  "Return all but the first element of the sequence SEQ.
If SEQ is nil or empty, return nil."
  (if (listp seq)
      (cdr seq)
    (when (not (empty-p seq))
      (drop 1 seq))))

;;;###autoload
(defun drop (n seq)
  "Return a subsequence, without its first N items, of the sequence SEQ."
  (let ((length (length seq)))
    (subseq seq (min n length) length)))

;;;###autoload
(defun take (n seq)
  "Return a sequence of the first N items of SEQ."
  (subseq seq 0 (min n (length seq))))

;;;###autoload
(defun filter (pred seq)
  "Return a list filtering with PRED all items of SEQ."
  (delq nil (mapcar (lambda (elt)
                      (and (funcall pred elt) elt))
                    seq)))

;;;###autoload
(defun reduce (function seq &optional initial-value)
  "Reduce two-argument FUNCTION across SEQ, starting with INITIAL-VALUE if not nil."
  (let ((acc (or initial-value (if (empty-p seq)
                                   (funcall function)
                                 (first seq)))))
    (mapc (lambda (item)
            (setq acc (funcall function acc item)))
          (if initial-value seq (rest seq)))
    acc))

;;;###autoload
(defun some-p (pred seq)
  "Return any element for which PRED is true in SEQ, nil otherwise."
  (car (filter pred seq)))

;;;###autoload
(defun every-p (pred seq)
  "Return t if (PRED item) is non-nil for all items of the sequence SEQ."
  (catch 'break
    (mapc (lambda (elt)
            (or (funcall pred elt) (throw 'break nil)))
          seq)
    t))

;;;###autoload
(defun empty-p (seq)
  "Return t if the sequence SEQ is empty, nil otherwise."
  (= 0 (length seq)))

;;;###autoload
(defun sort-seq (seq pred)
  "Sort the sequence SEQ comparing elements using PRED."
  (if (listp seq)
      (sort (copy-seq seq) pred)
    (sort-seq (append seq nil) pred)))

(defalias 'copy-seq #'copy-sequence)

;;;###autoload
(defun 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 (length seq)))))
           (if (< start 0) (setq start (+ start (or len (setq len (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))
             (copy-sequence seq))))
        (t (error "Unsupported sequence: %s" seq))))

;;;###autoload
(defun 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))))

(provide 'sequences)
;;; sequences.el ends here

[-- Attachment #3: sequences-tests.el --]
[-- Type: text/plain, Size: 5323 bytes --]

;;; 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-sequences-first ()
  (with-test-sequences (seq '(2 4 6))
    (should (= (first seq) 2)))
  (with-test-sequences (seq '())
    (should (eq (first seq) nil))))

(ert-deftest test-sequences-rest ()
  (with-test-sequences (seq '(2 4 6))
    (should (same-contents-p (rest seq) '(4 6))))
  (with-test-sequences (seq '())
    (should (eq (rest seq) nil))))

(ert-deftest test-sequences-drop ()
  (with-test-sequences (seq '(1 2 3 4))
    (should (equal (drop 0 seq) seq))
    (should (equal (drop 1 seq) (rest seq)))
    (should (equal (drop 2 seq) (rest (rest seq))))
    (should (empty-p (drop 4 seq)))
    (should (empty-p (drop 10 seq))))
  (with-test-sequences (seq '())
    (should (empty-p (drop 0 seq)))
    (should (empty-p (drop 1 seq)))))

(ert-deftest test-sequences-take ()
  (with-test-sequences (seq '(2 3 4 5))
    (should (empty-p (take 0 seq)))
    (should (= (length (take 1 seq)) 1))
    (should (= (first (take 1 seq)) 2))
    (should (same-contents-p (take 3 seq) '(2 3 4)))
    (should (equal (take 10 seq) seq))))

(ert-deftest test-sequences-filter ()
  (with-test-sequences (seq '(6 7 8 9 10))
    (should (equal (filter #'evenp seq) '(6 8 10)))
    (should (equal (filter #'oddp seq) '(7 9)))
    (should (equal (filter (lambda (elt) nil) seq) '())))
  (with-test-sequences (seq '())
    (should (equal (filter #'evenp seq) '()))))

(ert-deftest test-sequences-reduce ()
  (with-test-sequences (seq '(1 2 3 4))
    (should (= (reduce #'+ seq) 10))
    (should (= (reduce #'+ seq 5) 15)))
  (with-test-sequences (seq '())
    (should (eq (reduce #'+ seq) 0))
    (should (eq (reduce #'+ seq 7) 7))))

(ert-deftest test-sequences-some-p ()
  (with-test-sequences (seq '(4 3 2 1))
    (should (= (some-p #'evenp seq) 4))
    (should (= (some-p #'oddp seq) 3))
    (should-not (some-p (lambda (elt) (> elt 10)) seq)))
  (with-test-sequences (seq '())
    (should-not (some-p #'oddp seq))))

(ert-deftest test-sequences-every-p ()
  (with-test-sequences (seq '(43 54 22 1))
    (should (every-p (lambda (elt) t) seq))
    (should-not (every-p #'oddp seq))
    (should-not (every-p #'evenp seq)))
  (with-test-sequences (seq '(42 54 22 2))
    (should (every-p #'evenp seq))
    (should-not (every-p #'oddp seq)))
  (with-test-sequences (seq '())
    (should (every-p #'identity seq))
    (should (every-p #'evenp seq))))

(ert-deftest test-sequences-empty-p ()
  (with-test-sequences (seq '(0))
    (should-not (empty-p seq)))
  (with-test-sequences (seq '(0 1 2))
    (should-not (empty-p seq)))
  (with-test-sequences (seq '())
    (should (empty-p seq))))

(ert-deftest test-sequences-sort-seq ()
  (with-test-sequences (seq '(89 32 12 3 5 1 1))
    (should (equal (sort-seq seq #'<) '(1 1 3 5 12 32 89))))
  (with-test-sequences (seq '())
    (should (equal (sort-seq seq #'<) '()))))

(ert-deftest test-sequences-subseq ()
  (with-test-sequences (seq '(2 3 4 5))
    (should (equal (subseq seq 0 4) seq))
    (should (equal (subseq seq 2 4) (rest (rest seq))))
    (should (same-contents-p (subseq seq 1 3) '(3 4)))
    (should (same-contents-p (subseq seq 1 -1) '(3 4))))
  (should (vectorp (subseq [2 3 4 5] 2)))
  (should (stringp (subseq "foo" 2 3)))
  (should (listp (subseq '(2 3 4 4) 2 3))))

(ert-deftest test-sequences-concatenate ()
  (with-test-sequences (seq '(2 4 6))
    (should (equal (concatenate 'string seq [8]) (string 2 4 6 8)))
    (should (equal (concatenate 'list seq '(8 10)) '(2 4 6 8 10)))
    (should (equal (concatenate 'vector seq '(8 10)) [2 4 6 8 10]))
    (should (equal (concatenate 'vector nil '(8 10)) [8 10]))
    (should (equal (concatenate 'vector seq nil) [2 4 6]))))

(provide 'sequences-tests)
;;; sequences-tests.el ends here

[-- Attachment #4: Type: text/plain, Size: 964 bytes --]



It provides:

- coherent naming that fits well with existing sequence functions
- all functions work on lists, vectors and strings
- consistency:
  - all mapping functions take the sequence as their second argument
  - other sequence functions take the sequence as their their first
    argument
- all functions are documented
- all functions are tested

It adds the following functions: "first", "rest", "take", "drop",
"filter", "reduce", "some-p", "every-p", "empty-p", "sort-seq", "subseq"
and "concatenate". Together with existing mapping and other
sequence-manipulation functions I think it provides a good library. I
probably missed some though.

If you are interested, I'd like to have feedback on this, and I'm also
willing to update the documentation for sequences and send a proper
patch.

As I don't know what is the best way to submit a patch to Emacs, I
simply attached both elisp files. 


Cheers,
Nico
-- 
Nicolas Petton
http://nicolas-petton.fr

^ permalink raw reply	[flat|nested] 56+ messages in thread

end of thread, other threads:[~2014-11-24 18:01 UTC | newest]

Thread overview: 56+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2014-11-04 22:17 sequence manipulation functions Nicolas Petton
2014-11-05  1:21 ` Glenn Morris
2014-11-05  9:46   ` Nicolas Petton
2014-11-05  4:58 ` Richard Stallman
2014-11-05  9:45   ` Nicolas Petton
2014-11-06  0:54   ` Daniel Colascione
2014-11-05  9:23 ` Damien Cassou
2014-11-05 18:12   ` Richard Stallman
2014-11-05 21:59     ` Nicolas Petton
2014-11-05 22:40       ` Stefan Monnier
2014-11-06  0:30     ` Richard Stallman
2014-11-05 15:26 ` Stefan Monnier
2014-11-05 15:36   ` Nicolas Petton
2014-11-05 15:52     ` Sebastien Vauban
2014-11-05 18:32     ` Stefan Monnier
2014-11-07 17:35       ` [PATCH] " Nicolas Petton
2014-11-07 17:43         ` Daniel Colascione
2014-11-10 17:41         ` Stefan Monnier
2014-11-10 22:28           ` Nicolas Petton
2014-11-10 23:12           ` Nicolas Petton
2014-11-11  2:20             ` Stefan Monnier
2014-11-12 17:49               ` Nicolas Petton
2014-11-12 19:12                 ` Bozhidar Batsov
2014-11-12 19:30                   ` Nicolas Petton
2014-11-12 20:28                     ` Stefan Monnier
2014-11-12 20:56                       ` Nicolas Petton
2014-11-12 23:06                         ` Nicolas Petton
2014-11-12 23:17                           ` Nic Ferrier
2014-11-13  1:29                             ` Leo Liu
2014-11-13  5:21                               ` Drew Adams
2014-11-14  5:16                                 ` Leo Liu
2014-11-16 12:52                                   ` Bozhidar Batsov
2014-11-16 14:16                                     ` Nicolas Petton
2014-11-16 17:22                                       ` Drew Adams
2014-11-16 19:13                                       ` Stefan Monnier
2014-11-17  2:52                                         ` Richard Stallman
2014-11-17 11:46                                         ` Nicolas Petton
2014-11-17 13:53                                           ` Stefan Monnier
2014-11-16  7:38                           ` Damien Cassou
2014-11-20 23:16                           ` Stefan Monnier
2014-11-21 12:40                             ` Nicolas Petton
2014-11-21 13:11                               ` Stefan Monnier
2014-11-21 13:28                                 ` Nicolas Petton
2014-11-21 14:44                                   ` Stefan Monnier
2014-11-24 17:49                                     ` Nicolas Petton
2014-11-24 18:01                                       ` Nicolas Petton
2014-11-05 16:25   ` Drew Adams
2014-11-05 17:21     ` Artur Malabarba
2014-11-05 18:27       ` Drew Adams
2014-11-05 17:22     ` Damien Cassou
2014-11-05 18:28       ` Drew Adams
2014-11-05 17:41     ` Nicolas Petton
2014-11-05 18:23       ` Tom Tromey
2014-11-05 18:29         ` Drew Adams
2014-11-05 18:29       ` Drew Adams
2014-11-06  4:39         ` Richard Stallman

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).